Foxtable(狐表)用户栏目专家坐堂 → HTML报表


  共有2570人关注过本帖树形打印复制链接

主题:HTML报表

帅哥哟,离线,有人找我吗?
denghui69986
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:499 积分:3262 威望:0 精华:0 注册:2022/3/25 7:44:00
HTML报表  发帖心情 Post By:2023/7/25 18:01:00 [显示全部帖子]

在论坛看见一个不一样的报表,试了很多次,把下面代码统计一周需要修改成统计一个月,试了多次没改成功,老师帮忙指点统计一个月修改那里没看明白,谢谢

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=32104&authorid=0&page=0&star=1

 

Dim s1,s2,s3,flt,flt1,lms As String
Dim drs1 As List(of DataRow)
Dim sb1 As new StringBuilder
Dim n1,sn1 As Double
Dim v1,v2 As String() 
Dim d1 As Date

d1=Date.Today.Adddays(-Date.Today.DayOfWeek)
flt =  "日期 >= #" & d1 & "#"
s3 ="</Center></b></td>" & vbcrlf & New String(" ",6) & "<td><b><Center>"
lms = "日期,产品,数量,单价,折扣,金额,备注"
v1 = lms.split(",")
v2 = DataTables("订单").GetComboListString("姓名",flt).split("|")
sb1.Append("<html> <body background=""..\Images\bj.jpg""><Center>"  &  vbcrlf  &  vbcrlf)

For Each s1 In v2
    flt1 = "姓名 ='" & s1 & "' And " & flt
    drs1 =DataTables("订单").Select(flt1,"日期")
    sn1=DataTables("订单").Compute("sum(金额)",flt1)
    If s1 > v2(0) Then  
      sb1.Appendline("</Table>" )
      sb1.AppendLine("<pre>" & vbcrlf & vbcrlf & vbcrlf )
   Else
      sb1.AppendLine("<pre>")
   End If

    sb1.Append( "<h3><font color=""blue"">" & s1 & "</font> 本周报表" & new String(" ",13))
    sb1.Append("金额合计 : <font color=""blue"">¥" & Format(sn1,"#,###.00") & "</Font></pre></h3>")
    
    sb1.AppendLine(vbcrlf & vbcrlf & "<Table border=""1""")
    sb1.AppendLine("cellpadding=""20"">")
    sb1.AppendLine(vbcrlf  & "<h4>" & vbcrlf  & "<tr>")
    sb1.Appendline(New String(" ",6) & "<td><b><Center>" & lms.replace(",",s3) & "</Center></b></td>" )
    sb1.Appendline("</tr></h4>" )

    For Each dr As DataRow In drs1
        n1=0
        For Each s2 In v1
            If n1 = 0 Then sb1.Appendline( "<tr>")
            If dr.isnull(s2) Then
                sb1.Appendline(New String(" ",6) & "<td>&nbsp;</td>" )
            Else
                sb1.Appendline(New String(" ",6) & "<td>"  & Cstr(dr(s2)) & "</td>" )
            End If
              If n1 = v1.length-1 Then sb1.AppendLine("</tr>")        
            n1+=1
        Next
    Next
Next
sb1.Appendline( vbcrlf  & "</Center></body></html>")

flt =ProjectPath & "通讯记录\Test.Html"
FileSys.WriteAllText(flt,sb1.Tostring , False, Encoding.UTF8)
Dim Proc As New Process '定义一个新的Process
Proc.File = Flt
Proc.Start()

 回到顶部
帅哥哟,离线,有人找我吗?
denghui69986
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:499 积分:3262 威望:0 精华:0 注册:2022/3/25 7:44:00
  发帖心情 Post By:2023/7/26 7:31:00 [显示全部帖子]

感谢

 回到顶部