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