| ‘引用excel9.0 Dim tempxlApp As New Excel.Application Dim tempxlWorkbook As New Excel.Workbook Dim tempxlSheet As New Excel.Worksheet Dim tempRange As String Dim strRangeValue As String ‘打開(kāi)自己作好的報表模板templet.xlt Set tempxlWorkbook = tempxlApp.Workbooks.Open(App.Path & "\templet.xlt") tempxlApp.Visible = True tempxlApp.DisplayAlerts = False tempxlWorkbook.SaveAs "report.xls" Set tempxlSheet = tempxlWorkbook.Worksheets("sheet1") tempxlSheet.Select ‘單個(gè)單元格寫(xiě)入數據 tempxlSheet.Range("A1").Value = "test" ‘一次性寫(xiě)入tempRs數據記錄集中的數據 tempxlSheet.Range("A1").CopyFromRecordset tempRS ‘保存 tempxlApp.save ‘釋放對象 Set tempxlSheet = Nothing Set tempxlWorkbook = Nothing ‘關(guān)閉excel tempxlApp.Quit ‘千萬(wàn)別忘記寫(xiě)下面這一句，否則excel進(jìn)程不會(huì )關(guān)閉 Set tempxlApp = Nothing | | Top | | | 回復人： y97523szb() ( ) 信譽(yù)：100 | 2002-04-26 05:30:50Z | 得分:10 | | | | icy_csdn() 的程序差不多 不過(guò)用前首先在自己的程序的引用中將Excel（office)的對象引用 關(guān)于Excel對象的資料你可以在Excel的幫助中找到（打開(kāi)Excel，從宏菜單中啟動(dòng)VBA編輯器，那是一個(gè)office中的VB,F1就可以調出幫助） 主要就是幾個(gè)對象： Application Workbook Worksheet 別忘了給分：） | | Top | | | 回復人： cgh1970(聊天別找我) ( ) 信譽(yù)：100 | 2002-04-26 06:19:31Z | 得分:20 | | | | ‘指定鏈接 Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long ‘Option Explicit Dim x(1 To 4, 1 To 5) As Integer Dim a, i, j As Integer Dim b As String Private Sub Command1_Click() Dim ex As Object Dim exbook As Object Dim exsheet As Object Set ex = CreateObject("Excel.Application") Set exbook = ex.Workbooks().Add Set exsheet = exbook.Worksheets("sheet1") ‘按控件的內容賦值 ‘11 exsheet.Cells(1, 1).Value = Text1.Text ‘為同行的幾個(gè)格賦值 Range("C3").Select ActiveCell.FormulaR1C1 = "表格" ‘ ex.Range("c3").Value = "表 格" ex.Range("d3").Value = " 春 天 " ex.Range("e3").Value = " 夏 天 " ex.Range("f3").Value = " 秋 天 " ex.Range("g3").Value = " 冬 天 " ‘大片賦值 ex.Range("c4:g7").Value = x ‘按變量賦值 a = 8 b = "c" & Trim(Str(a)) ex.Range(b).Value = "下雪" ‘另外一種大片賦值 For i = 9 To 12 For j = 4 To 7 exsheet.Cells(i, j).Value = i * j Next j Next i ‘計算賦值 exsheet.Cells(13, 1).Formula = "=R9C4 + R9C5" ‘設置字體 Dim exRange As Object Set exRange = exsheet.Cells(13, 1) exRange.Font.Bold = True ‘設置一行為18號字體加黑 Rows("3:3").Select Selection.Font.Bold = True With Selection.Font .Name = "宋體" .Size = 18 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With ‘設置斜體 Range("E2").Select Selection.Font.Italic = True ‘設置下劃線(xiàn) Range("E3").Select Selection.Font.Underline = xlUnderlineStyleSingle ‘設置列寬為15 Selection.ColumnWidth = 15 ‘設置一片數據居中 Range("C4:G7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With ‘設置某區域的小數位數 Range("F4:F7").Select Selection.NumberFormatLocal = "0.00" ‘求和 Range("G9:G13").Select Range("G13").Activate ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)" ‘某列自動(dòng)縮放寬度 Columns("C:C").EntireColumn.AutoFit ‘畫(huà)表格 Range("C4:G7").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With ‘加黑框 Range("C9:G13").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ‘設置某單元格格式為文本 Range("E11").Select Selection.NumberFormatLocal = "@" ‘設置單元格格式為數值 Range("F10").Select Selection.NumberFormatLocal = "0.000_);(0.000)" ‘設置單元格格式為時(shí)間 Range("F11").Select Selection.NumberFormatLocal = "h:mm AM/PM" ‘取消選擇 Range("C10").Select ‘設置橫向打印，A4紙張 ‘ With ActiveSheet.PageSetup ‘ .PrintTitleRows = "" ‘ .PrintTitleColumns = "" ‘ End With ‘ ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup ‘ .LeftHeader = "" ‘ .CenterHeader = "" ‘ .RightHeader = "" ‘ .LeftFooter = "" ‘ .CenterFooter = "" ‘ .RightFooter = "" ‘ .LeftMargin = Application.InchesToPoints(0.75) ‘ .RightMargin = Application.InchesToPoints(0.75) ‘ .TopMargin = Application.InchesToPoints(1) ‘ .BottomMargin = Application.InchesToPoints(1) ‘ .HeaderMargin = Application.InchesToPoints(0.5) ‘ .FooterMargin = Application.InchesToPoints(0.5) ‘ .PrintHeadings = False ‘ .PrintGridlines = False ‘ .PrintComments = xlPrintNoComments ‘ .PrintQuality = 300 ‘ .CenterHorizontally = False ‘ .CenterVertically = False .Orientation = xlLandscape ‘ .Draft = False .PaperSize = xlPaperA4 ‘ .FirstPageNumber = xlAutomatic ‘ .Order = xlDownThenOver ‘ .BlackAndWhite = False ‘ .Zoom = 100 End With ‘跨列居中 Range("A1:G1").Select With Selection .HorizontalAlignment = xlCenter ‘ .VerticalAlignment = xlBottom ‘ .WrapText = False ‘ .Orientation = 0 ‘ .AddIndent = False ‘ .ShrinkToFit = False .MergeCells = True End With Selection.Merge ‘打印表格 ActiveWindow.SelectedSheets.PrintOut Copies:=1 ‘取值 Text1.Text = exsheet.Cells(13, 1) ‘保存 ChDir "C:\WINDOWS\Desktop" ActiveWorkbook.SaveAs FileName:="C:\WINDOWS\Desktop\aaa.xls", FileFormat:=xlNormal, Password:="123", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ‘ 關(guān)閉工作表。 exbook.Close ‘用 Quit 方法關(guān)閉 Microsoft Excel ex.Quit ‘釋放對象 Set ex = Nothing Set exbook = Nothing Set exsheet = Nothing Dim retval ‘用excel打開(kāi)表格 retval = Shell("C:\Program Files\Microsoft Office\Office\EXCEL.EXE" & " " & "C:\WINDOWS\Desktop\aaa.xls", 1) End Sub Private Sub Form_Load() Me.Show End Sub Private Sub Image2_Click() ‘打開(kāi)主頁(yè) ret& = ShellExecute(Me.hwnd, "Open", "http://dyqing.533.net", "", App.Path, 1) End Sub Private Sub Image1_Click() ‘發(fā)送郵件 ret& = ShellExecute(Me.hwnd, "Open", "mailto:duyunqing@163.net", "", App.Path, 1) End Sub | | Top | | | 回復人： dbcontrols(泰山__拋磚引玉) ( ) 信譽(yù)：被封殺 | 2002-04-26 06:47:17Z | 得分:10 | | | | cgh1970() :復制我的代碼就算了，怎么連我的郵箱也列出來(lái)??？ :P | | Top | | | 回復人： setfocus(斗是懂一點(diǎn)) ( ) 信譽(yù)：100 | 2002-04-26 08:30:33Z | 得分:10 | | | | 哈哈哈！搞笑呀！搜索一下帖子吧！原來(lái)有很多！ | | Top | | | 回復人： _1_(到j(luò )inesc.6600.org來(lái)找我) ( ) 信譽(yù)：100 | 2002-04-26 08:35:29Z | 得分:20 | | | | 我也來(lái)貼一個(gè)， 不太復雜的 ， 就是非常的長(cháng) 屬于好玩 ，你看看吧~~~ Form_Wait.Maxid = Detail.Rows + 20 Form_Wait.aa = 0 Dim r As New ADODB.Recordset Dim SQL As String ‘用輸出到excel的方法打印 Dim Ex As New Excel.Application Dim ExW As Excel.Workbook Dim Exs As Excel.Worksheet Dim i As Integer Dim t As Integer Dim n As Integer Dim tempSt As String Dim totamount As Double Dim totqty As Double t = 1 On Error Resume Next Kill App.Path & "\intemp.xls" FileCopy App.Path & "\xls.dll", App.Path & "\intemp.xls" On Error GoTo 0 Set Ex = CreateObject("Excel.Application") Set ExW = Ex.Workbooks.Open(App.Path & "\intemp.xls") Set Exs = ExW.Worksheets("sheet1") Form_Wait.aa = 5 ‘表頭 ‘公司名稱(chēng) Exs.Cells(1, 2).Font.Name = "Times New Roman" Exs.Cells(1, 2).Font.Size = 14 Exs.Cells(1, 2).Font.Bold = True Exs.Cells(1, 2) = tt1 ‘公司地址 Exs.Cells(2, 2).Font.Name = "Times New Roman" Exs.Cells(2, 2).Font.Size = 9 Exs.Cells(2, 2).Font.Italic = True Exs.Cells(2, 2) = tt2 ‘公司電話(huà) Exs.Cells(3, 2).Font.Name = "Times New Roman" Exs.Cells(3, 2).Font.Size = 8 Exs.Cells(3, 2).Font.Italic = True Exs.Cells(3, 2) = tt3 Exs.Range("a1:a3").MergeCells = True ‘公司標記 Exs.Cells(1, 1).Font.Name = "Braggadocio" Exs.Cells(1, 1).Font.Size = 28 Exs.Cells(1, 1).Font.Italic = True Exs.Cells(1, 1) = "JINESC" Exs.Columns("A:A").ColumnWidth = 17.13 Exs.Columns("B:B").ColumnWidth = 25.25 Exs.Columns("C:C").ColumnWidth = 11.63 Exs.Columns("D:D").ColumnWidth = 12 Exs.Columns("E:E").ColumnWidth = 11.63 With Exs ‘行高和畫(huà)2根線(xiàn) .Rows("1:1").RowHeight = 16.25 .Rows("2:2").RowHeight = 12.25 .Rows("3:3").RowHeight = 12.25 .Shapes.AddLine(6#, 47.25, 479.25, 47.25).Line.Weight = 2.25 .Shapes.AddLine(6#, 50.25, 479.25, 50.25).Line.Weight = 1 Form_Wait.aa = 10 ‘表頭公司名稱(chēng)制作完畢 ‘下面開(kāi)始做發(fā)票資料 ‘客戶(hù)資料 .Cells(5, 1).Font.Name = "Times New Roman" .Cells(5, 1).Font.Size = 10 .Cells(5, 1).Font.Italic = True .Cells(5, 1) = "TO:" & TXTKHMC .Range("a5:b5").MergeCells = True .Range("a6:b6").MergeCells = True .Cells(6, 1) = Text4 ‘發(fā)票號 .Cells(5, 3).Font.Name = "Times New Roman" .Cells(5, 3).Font.Size = 10 .Cells(5, 3).Font.Italic = True .Cells(5, 3) = "Invoice No:" .Cells(5, 4) = TXTINVOICE ‘日期 .Cells(6, 3).Font.Name = "Times New Roman" .Cells(6, 3).Font.Size = 10 .Cells(6, 3).Font.Italic = True .Cells(6, 3) = "Date:" .Cells(6, 4) = Format(Rq, "MMM,dd,yyyy") ‘合同浩 .Cells(7, 3).Font.Name = "Times New Roman" .Cells(7, 3).Font.Size = 10 .Cells(7, 3).Font.Italic = True .Cells(7, 3) = "Contract No:" .Cells(8, 4) = Text5 .Range("d7:e8").MergeCells = True ‘定單浩 .Cells(7, 1).Font.Name = "Times New Roman" .Cells(7, 1).Font.Size = 10 .Cells(7, 1).Font.Italic = True .Cells(7, 1) = "Order No:" & Text1 .Cells(7, 1).VerticalAlignment = xlTop .Range("a7:b11").MergeCells = True ‘麥頭 .Cells(9, 3).Font.Name = "Times New Roman" .Cells(9, 3).Font.Size = 10 .Cells(9, 3).Font.Italic = True .Cells(9, 3) = "Marks:" .Cells(9, 4) = Text2 .Range("d9:e11").MergeCells = True ‘INVOICE大字 .Cells(12, 1).Font.Name = "Times New Roman" .Cells(12, 1).Font.Size = 28 .Cells(12, 1).Font.Italic = True .Cells(12, 1).HorizontalAlignment = xlCenter .Cells(12, 1) = "Invoice" .Range("a12:E12").MergeCells = True ‘表格頭 .Cells(12, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(12, 1).Borders(xlEdgeBottom).Weight = xlMedium .Cells(12, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(12, 2).Borders(xlEdgeBottom).Weight = xlMedium .Cells(12, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(12, 3).Borders(xlEdgeBottom).Weight = xlMedium .Cells(12, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(12, 4).Borders(xlEdgeBottom).Weight = xlMedium .Cells(12, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(12, 5).Borders(xlEdgeBottom).Weight = xlMedium ‘表格割線(xiàn) .Cells(14, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(14, 1).Borders(xlEdgeBottom).Weight = xlThin .Cells(14, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(14, 2).Borders(xlEdgeBottom).Weight = xlThin .Cells(14, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(14, 3).Borders(xlEdgeBottom).Weight = xlThin .Cells(14, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(14, 4).Borders(xlEdgeBottom).Weight = xlThin .Cells(14, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(14, 5).Borders(xlEdgeBottom).Weight = xlThin Form_Wait.aa = 15 | | Top | | | 回復人： _1_(到j(luò )inesc.6600.org來(lái)找我) ( ) 信譽(yù)：100 | 2002-04-26 08:36:01Z | 得分:0 | | | | ‘明細內容的表頭 ‘Description Of Goods .Cells(13, 1).Font.Name = "Times New Roman" .Cells(13, 1).Font.Size = 11 .Cells(13, 1).Font.Bold = True .Cells(13, 1).HorizontalAlignment = xlCenter .Cells(13, 1) = "Description Of Goods" ‘TYPE .Cells(13, 2).Font.Name = "Times New Roman" .Cells(13, 2).Font.Size = 11 .Cells(13, 2).Font.Bold = True .Cells(13, 2).HorizontalAlignment = xlCenter .Cells(13, 2) = "Type" ‘Quantity .Cells(13, 3).Font.Name = "Times New Roman" .Cells(13, 3).Font.Size = 11 .Cells(13, 3).Font.Bold = True .Cells(13, 3).HorizontalAlignment = xlCenter .Cells(13, 3) = "Quantity" ‘PCS .Cells(14, 3).Font.Name = "Times New Roman" .Cells(14, 3).Font.Size = 11 .Cells(14, 3).Font.Bold = True .Cells(14, 3).HorizontalAlignment = xlCenter .Cells(14, 3) = "(PCS)" ‘Unit Price .Cells(13, 4).Font.Name = "Times New Roman" .Cells(13, 4).Font.Bold = True .Cells(13, 4).Font.Size = 11 .Cells(13, 4).HorizontalAlignment = xlCenter .Cells(13, 4) = "Unit Price" ‘Amount .Cells(13, 5).Font.Name = "Times New Roman" .Cells(13, 5).Font.Size = 11 .Cells(13, 5).Font.Bold = True .Cells(13, 5).HorizontalAlignment = xlCenter .Cells(13, 5) = "Amount" ‘Unit Price 貨幣 .Cells(14, 4).Font.Name = "Times New Roman" .Cells(14, 4).Font.Bold = True .Cells(14, 4).Font.Size = 11 .Cells(14, 4).HorizontalAlignment = xlCenter .Cells(14, 4) = "(" & TXTHB & ")" ‘Amount 貨幣 .Cells(14, 5).Font.Name = "Times New Roman" .Cells(14, 5).Font.Size = 11 .Cells(14, 5).Font.Bold = True .Cells(14, 5).HorizontalAlignment = xlCenter .Cells(14, 5) = "(" & TXTHB & ")" End With Form_Wait.aa = 20 ‘以下假如顯示內容 主要是 商品名稱(chēng) 規格 數量 單價(jià) 金額 單位 Dim stt1 As String Dim stt2 As String Dim stt3 As String Dim stt4 As String With Detail For i = 1 To .Rows - 1 Form_Wait.aa = 20 + i .row = i .col = 3 If Not Trim(.Text) = "" Then .col = 5 If IsNumeric(.Text) Then totqty = totqty + CDbl(.Text) .col = 7 If IsNumeric(.Text) Then totamount = totamount + CDbl(.Text) ‘商品名稱(chēng) .col = 1 If stt1 <> Trim(.Text) Then Exs.Cells(t + 14, 1).Font.Name = "Times New Roman" Exs.Cells(t + 14, 1).Font.Size = 9 Exs.Cells(t + 14, 1).HorizontalAlignment = xlLeft Exs.Cells(t + 14, 1) = .Text stt1 = Trim(.Text) t = t + 1 End If .col = 8 If stt2 <> Trim(.Text) Then Exs.Cells(t + 14, 1).Font.Name = "Times New Roman" Exs.Cells(t + 14, 1).Font.Size = 9 Exs.Cells(t + 14, 1).HorizontalAlignment = xlLeft Exs.Cells(t + 14, 1) = .Text stt2 = Trim(.Text) End If .col = 3 ‘規格 Exs.Cells(t + 14, 2).Font.Name = "Times New Roman" Exs.Cells(t + 14, 2).Font.Size = 9 Exs.Cells(t + 14, 2).HorizontalAlignment = xlLeft Exs.Cells(t + 14, 2) = .Text ‘數量 .col = 5 Exs.Cells(t + 14, 3).Font.Name = "Times New Roman" Exs.Cells(t + 14, 3).Font.Size = 9 Exs.Cells(t + 14, 3).HorizontalAlignment = xlRight Exs.Cells(t + 14, 3) = .Text .col = 6 Exs.Cells(t + 14, 4).Font.Name = "Times New Roman" Exs.Cells(t + 14, 4).Font.Size = 9 Exs.Cells(t + 14, 4).HorizontalAlignment = xlRight Exs.Cells(t + 14, 4) = .Text ‘金額 .col = 7 Exs.Cells(t + 14, 5).Font.Name = "Times New Roman" Exs.Cells(t + 14, 5).Font.Size = 9 Exs.Cells(t + 14, 5).HorizontalAlignment = xlRight Exs.Cells(t + 14, 5) = .Text t = t + 1 End If Next ‘明細內容結束 畫(huà)結尾表格線(xiàn) Exs.Cells(13 + t, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous Exs.Cells(13 + t, 1).Borders(xlEdgeBottom).Weight = xlThin Exs.Cells(13 + t, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Exs.Cells(13 + t, 2).Borders(xlEdgeBottom).Weight = xlThin Exs.Cells(13 + t, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Exs.Cells(13 + t, 3).Borders(xlEdgeBottom).Weight = xlThin Exs.Cells(13 + t, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Exs.Cells(13 + t, 4).Borders(xlEdgeBottom).Weight = xlThin Exs.Cells(13 + t, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous Exs.Cells(13 + t, 5).Borders(xlEdgeBottom).Weight = xlThin End With With Exs ‘匯總數量和金額 .Cells(14 + t, 1).Font.Name = "Times New Roman" .Cells(14 + t, 1).Font.Size = 11 .Cells(14 + t, 1).Font.Bold = True .Cells(14 + t, 1) = "Total Quantity:" & totqty & "pcs Total Amount:(" & Me.TXTHB & ")" & totamount & " " & Me.TXTJG & " " & Me.TXTGK ‘備注 .Cells(16 + t, 1).Font.Name = "Times New Roman" .Cells(16 + t, 1).Font.Size = 11 .Cells(16 + t, 1).Font.Bold = True .Rows(16 + t).WrapText = True .Cells(16 + t, 1) = Text3 & vbCrLf & "We hereby certify that the above mentioned goods ase of chinese origin " .Range("a" & 14 + t & ":E" & 14 + t).MergeCells = True .Range("a" & 16 + t & ":E" & 16 + t).MergeCells = True End With Exs.Application.Visible = True End Sub 看樓上發(fā)那么多的代碼 我也發(fā)個(gè)長(cháng)代碼來(lái)看看 | | Top | | | | | | | | | 用VB控制EXCEL生成報表 做為一種簡(jiǎn)捷、系統的 Windows應用程序開(kāi)發(fā)工具，Visual Basic 5 具有強大的數據處理功能，提供了多種數據訪(fǎng)問(wèn)方法，可以方便地存取 Microsoft SQL Server、Oracle、XBase等多種數據庫，被廣泛應用于建立各種信息管理系統。但是，VB缺乏足夠的、符合中文習慣的數據表格輸出功能， 雖然使用Crystal Report控件及 Crystal Reports程序可以輸出報表，但操作起來(lái)很麻煩，中文處理能力也不理想。Excel作為Micorsoft公司的表格處 理軟件在表格方面有著(zhù)強大的功能，我們可用VB5編寫(xiě)直接控制Excel操作的程序,方法是用VB的OLE自動(dòng)化技術(shù)獲取Excel 97 的控制句柄,從而直接控制 Excel 97的一系列操作。 下面給出一個(gè)實(shí)例： 首先建立一個(gè)窗體（FORM1）在窗體中加入一個(gè)DATA控件和一按鈕， 引用Microsoft Excel類(lèi)型庫: 從"工程"菜單中選擇"引用"欄; 選擇Microsoft Excel 8.0 Object Library; 選擇"確定"。 在FORM的LOAD事件中加入： Data1.DatabaseName = 數據庫名稱(chēng) Data1.RecordSource = 表名 Data1.Refresh 在按鈕的CLICK事件中加入 Dim Irow, Icol As Integer Dim Irowcount, Icolcount As Integer Dim Fieldlen() "存字段長(cháng)度值 Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) With Data1.Recordset .MoveLast If .RecordCount < 1 Then MsgBox ("Error 沒(méi)有記錄!") Exit Sub End If Irowcount = .RecordCount "記錄總數 Icolcount = .Fields.Count "字段總數 ReDim Fieldlen(Icolcount) .MoveFirst 8 For Irow = 1 To Irowcount + 1 For Icol = 1 To Icolcount Select Case Irow Case 1 "在Excel中的第一行加標題 xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name Case 2 "將數組FIELDLEN()存為第一條記錄的字段長(cháng) If IsNull(.Fields(Icol - 1)) = True Then Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name) "如果字段值為NULL,則將數組Filelen(Icol)的值設為標題名的寬度 Else Fieldlen(Icol) = LenB(.Fields(Icol - 1)) End If xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol) "Excel列寬等于字段長(cháng) xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1) "向Excel的CellS中寫(xiě)入字段值 Case Else Fieldlen1 = LenB(.Fields(Icol - 1)) If Fieldlen(Icol) < Fieldlen1 Then xlSheet.Columns(Icol).ColumnWidth = Fieldlen1 "表格列寬等于較長(cháng)字段長(cháng) Fieldlen(Icol) = Fieldlen1 "數組Fieldlen(Icol)中存放最大字段長(cháng)度值 Else xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol) End If xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1) End Select Next If Irow <> 1 Then If Not .EOF Then .MoveNext End If Next With xlSheet .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑體" "設標題為黑體字 .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True "標題字體加粗 .Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous "設表格邊框樣式 End With xlApp.Visible = True "顯示表格 xlBook.Save "保存 Set xlApp = Nothing "交還控制給Excel End With | |
