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

核心提示：小弟獻醜一回了，各位大俠請不要砸我，《用做好的Excel報表模板來做報表》，要砸輕點砸，這兩天感冒了--2005、07、14《用做好的Excel報表模板來做報表》首先需要有個已經做好的excel報表模板，而自己手邊又沒有完善的數據，sql語句自己可以靈活的寫，本例的是：tabOrder.xls裡面技術不多，就是復制模板

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