小弟獻醜一回了，各位大俠請不要砸我，要砸輕點砸，這兩天感冒了
--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圖片如下：
