vba 编写自动报表

最新推荐文章于 2024-05-06 08:34:06 发布

似剑非攻_墨眉无锋

最新推荐文章于 2024-05-06 08:34:06 发布

阅读量4.1k

点赞数

分类专栏： VBA

本文链接：https://blog.csdn.net/ivory_town1/article/details/50923276

版权

VBA 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

 Sub qr_report_week_click()
    Dim conn As ADODB.Conn
    Dim rs As ADODB.Reco
    Dim i As Integer
    Dim sql As String, sdate As String, edate As String
    Set conn = CreateObjct("ADDB.Contion")
    conn.ConnecnString = "DRIVER={MySQL ODBC 5.3 Unicode Driver};SERVER=192.168.0.3;Database=test;Uid=test;Pwd=test"  
    
    conn.Open
    Set rs = New ADODB.Recordset
    sdate = InputBox("请输入起始日期，格式如 2016-02-01", "起始日期", Format(DateAdd("d", -7, Now), "yyyy-mm-dd"))
    edate = InputBox("请输入终止日期，格式如 2016-02-07", , Format(Now, "yyyy-mm-dd"))
    sql = "SELECT ....."
    rs.Open sql, conn
    rs.MoveFirst
   Set sht = ThisWorkbook.Worksheets("周新增统计")
   sht.Range("A2:E2").ClearContents
    i = 2
Do While Not rs.EOF

    sht.Cells(i, 1) = rs("date")
    sht.Cells(i, 2) = rs("register")
    sht.Cells(i, 3) = rs("bind")
    sht.Cells(i, 4) = rs("activat")
    sht.Cells(i, 5) = rs("lv")
    
    rs.MoveNext
    i = i + 1
Loop

'累计统计

Set rs = New ADODB.Recordset
    sql = "SELECT ....."
    rs.Open sql, conn
    rs.MoveFirst
    
   Set sht = ThisWorkbook.Worksheets("累计统计")
   sht.Range("A2:E2").ClearContents
    i = 2
Do While Not rs.EOF

    
    sht.Cells(i, 1) = rs("register")
    sht.Cells(i, 2) = rs("activat")
    sht.Cells(i, 3) = rs("lv")
    
    rs.MoveNext
    i = i + 1
Loop
'周（每日统计）
Set rs = New ADODB.Recordset
    sql = "SELECT DATE_....."
    rs.Open sql, conn
    rs.MoveFirst
    
   Set sht = ThisWorkook.Worksheets("周（每日统计）")
   sht.Rang("A2:E100").ClearContents
    i = 2
Do While Not rs.EOF

    
    sht.Cells(i, 1) = rs("date")
    sht.Cells(i, 2) = rs("register")
    sht.Cells(i, 3) = rs("bind")
    sht.Cells(i, 4) = rs("activat")
    sht.Cells(i, 5) = rs("lv")
    
    rs.MoveNext
    i = i + 1
Loop
    MsgBox "报表生成完成！"
    conn.Close
    Set conn = Nothing
End Sub

得到的测试结果如下：