《用做好的Excel報表模板來做報表》

2019-11-17 05:26:28

字体：大中小

来源：转载

供稿：网友

小弟獻醜一回了，各位大俠請不要砸我，要砸輕點砸，這兩天感冒了
    --2005、07、14
《用做好的Excel報表模板來做報表》
首先需要有個已經做好的excel報表模板，本例的是：tabOrder.xls
裡面技術不多，就是復制模板的時候有點技巧
PRivate Sub Command1_Click()
    '訂貨單報表
    Dim xlApp As Excel.application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet

    Dim strPubConnect As New ADODB.Connection
    With strPubConnect
        .ConnectionString = "Provider=SQLOLEDB.1;PassWord=sa;Persist Security Info=True;User ID=sa;Initial Catalog=Northwind;Data Source=A382"
        .CommandTimeout = 0
        .Open
    End With

    Dim rsQuery As New ADODB.Recordset
    Dim strSql As String
    Dim strPathName As String
    Dim strPathExcel As String
    Dim intCountNum As Integer

    strPathExcel = "D:/ProdUCt Skill/ToExcel/tabOrder.xls" 'excel報表模板路徑(一般放在網絡盤,因為公司的報表會集中在一塊)

    DialogReport.DefaultExt = "*.xls"
    DialogReport.Filter = "Excel(*.xls)*.xls"
    DialogReport.ShowSave
    strPathName = DialogReport.FileName    If strPathName = strName Then
        Screen.MousePointer = 0
        Exit Sub
    End If
    If strPathName = "" Then
        Screen.MousePointer = 0
        Exit Sub
    End If

    Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(strPathExcel)
    Set xlSheet = xlBook.Worksheets(1)
    xlApp.DataEntryMode = xlOff

    Dim intPages As Integer
    Dim intOrderI As Integer

    '**********************統計有多少頁********************
    Set rsQuery = New ADODB.Recordset
    strSql = "select OrderID,CustomerID,EmployeeID,ShipVia,Freight,ShipName,ShipCity,ShipPostalcode from orders"
    rsQuery.Open strSql, strPubConnect, adOpenStatic
        If Not rsQuery.EOF Then
            If (rsQuery.RecordCount / 23) - Int(rsQuery.RecordCount / 23) > 0 Then
                intPages = Int(rsQuery.RecordCount / 23) + 1
            Else
                intPages = Int(rsQuery.RecordCount / 23)
            End If
            If intPages = 0 Then
                intPages = 1
            End If

            rsQuery.Close
        Else
            rsQuery.Close
        End If
    '**********************統計有多少頁********************

    '**********************根據統計出來的頁數進行復制******
    For intOrderI = 1 To intPages - 1
        xlSheet.Range("A1:R52").Copy Destination:=xlSheet.Range("A" & Trim(Str(52 * intOrderI + 1)))
    Next
    '**********************根據統計出來的頁數進行復制******

    '父表
'    Dim intCount As Integer
    Dim intJ As Integer
    Set rsQuery = New ADODB.Recordset
    strSql = "select top 1 EmployeeID,LastName,FirstName,Title,HireDate,City,Region,PostalCode,Country,HomePhone,Address from Employees"
    rsQuery.Open strSql, strPubConnect, adOpenStatic

    If rsQuery.EOF = False Then
        For intJ = 0 To intPages - 1
            xlSheet.Cells(52 * intJ + 6, 3) = rsQuery("EmployeeID") & ""
            xlSheet.Cells(52 * intJ + 7, 3) = rsQuery("FirstName") & ""
            xlSheet.Cells(52 * intJ + 8, 3) = rsQuery("HomePhone") & ""
            xlSheet.Cells(52 * intJ + 9, 3) = rsQuery("HomePhone") & ""
            xlSheet.Cells(52 * intJ + 10, 3) = rsQuery("LastName") & ""
            xlSheet.Cells(52 * intJ + 11, 3) = rsQuery("Address") & ""
            xlSheet.Cells(52 * intJ + 10, 7) = rsQuery("PostalCode") & ""
'            xlSheet.Cells(52 * intJ + 8, 7) = rsQuery("sum_money") & ""
            xlSheet.Cells(52 * intJ + 7, 7) = rsQuery("city") & ""
            xlSheet.Cells(52 * intJ + 9, 7) = rsQuery("title") & ""
        Next
    End If
    Set rsQuery = Nothing


    '子表
    Set rsQuery = New ADODB.Recordset
    strSql = "select OrderID,CustomerID,EmployeeID,ShipVia,Freight,ShipName,ShipCity,ShipPostalcode from orders"
    rsQuery.Open strSql, strPubConnect, adOpenStatic

    If (rsQuery.RecordCount / 23) - Int(rsQuery.RecordCount / 23) > 0 Then
        intPages = Int(rsQuery.RecordCount / 23) + 1
    Else
        intPages = Int(rsQuery.RecordCount / 23)
    End If
    If intPages = 0 Then
        intPages = 1
    End If

    For intOrderI = 1 To intPages - 1
        xlSheet.Range("A1:R52").Copy Destination:=xlSheet.Range("A" & Trim(Str(52 * intOrderI + 1)))
    Next

    Dim n As Integer
    Dim i As Integer
    Dim dboMoney As Double
    i = 0
    If rsQuery.EOF = False Then
        For n = 1 To rsQuery.RecordCount
            If n = 23 * (i + 1) + 1 Then
                i = i + 1
            End If
'            xlSheet.Cells(52 * i + 13 + n - (23 * i), 1) = n
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 2) = rsQuery("CustomerID") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 3) = rsQuery("OrderID") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 4) = rsQuery("ShipName") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 5) = rsQuery("Freight") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 6) = rsQuery("OrderID") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 7) = rsQuery("ShipVia") & ""
            xlSheet.Cells(52 * i + 13 + n - (23 * i), 8) = rsQuery("ShipPostalcode") & ""
'            dboMoney = dboMoney + rsQuery("money") & ""
            If n = rsQuery.RecordCount Then
                xlSheet.Cells(52 * i + 13 + n - (23 * i) + 1, 3) = "( 以下空白 )"
            End If
            rsQuery.MoveNext
        Next n
    End If
    Set rsQuery = Nothing

    strCompanyID = ""
    strOutDate = ""
    xlBook.SaveAs strPathName
    strName = strPathName
    xlApp.Visible = True
''    xlBook.Close
    Set xlApp = Nothing
    Screen.MousePointer = 0
End Sub
這個報表被分成了兩部分，第一部分是供應商的基本資料，下一部分產品資料。(一個供應商對應N多的產品資料)
這樣方便於根據每個供應商來做成各自的報表，其中本例中所引用的數據是Sql數據庫Employees表和orders表
中的資料，不過我是為了能夠體現出這個報表，而自己手邊又沒有完善的數據，sql語句自己可以靈活的寫，
可以自己寫成些統計之和等都可以實現。
相關EXCEL圖片如下：《用做好的Excel報表模板來做報表》