用VB控制EXCEL生成報表

2019-11-18 17:37:33

字體：大中小

供稿：網(wǎng)友

做為一種簡捷、系統(tǒng)的Windows應(yīng)用程序開發(fā)工具，VisualBasic5具有強大的數(shù)據(jù)處理功能，提供了多種數(shù)據(jù)訪問方法，可以方便地存取MicrosoftSQLServer、Oracle、XBase等多種數(shù)據(jù)庫，被廣泛應(yīng)用于建立各種信息管理系統(tǒng)。但是，VB缺乏足夠的、符合中文習(xí)慣的數(shù)據(jù)表格輸出功能，雖然使用CrystalReport控件及CrystalReports程序可以輸出報表，但操作起來很麻煩，中文處理能力也不理想。Excel作為Micorsoft公司的表格處理軟件在表格方面有著強大的功能，我們可用VB5編寫直接控制Excel操作的程序,方法是用VB的OLE自動化技術(shù)獲取Excel97的控制句柄,從而直接控制Excel97的一系列操作。

下面給出一個實例：

首先建立一個窗體（FORM1）在窗體中加入一個DATA控件和一按鈕，

引用MicrosoftExcel類型庫:

從"工程"菜單中選擇"引用"欄;

選擇MicrosoftExcel8.0ObjectLibrary;

選擇"確定"。

在FORM的LOAD事件中加入：
　　Data1.DatabaseName=數(shù)據(jù)庫名稱
　　Data1.RecordSource=表名
　　Data1.Refresh

在按鈕的CLICK事件中加入
　　DimIrow,IcolAsInteger
　　DimIrowcount,IcolcountAsInteger
　　DimFieldlen()"存字段長度值
　　DimxlAppAsExcel.application
　　DimxlBookAsExcel.Workbook
　　DimxlSheetAsExcel.Worksheet

　　SetxlApp=CreateObject("Excel.Application")
　　SetxlBook=xlApp.Workbooks.Add
　　SetxlSheet=xlBook.Worksheets(1)

　　WithData1.Recordset
　　.MoveLast

　　If.RecordCount<1Then
　　　　MsgBox("Error沒有記錄!")
　　　　ExitSub
　　EndIf

　　Irowcount=.RecordCount"記錄總數(shù)
　　Icolcount=.Fields.Count"字段總數(shù)

　　ReDimFieldlen(Icolcount)
　　.MoveFirst

8

　　ForIrow=1ToIrowcount 1
　　　ForIcol=1ToIcolcount
　　SelectCaseIrow
　　Case1"在Excel中的第一行加標題
　　xlSheet.Cells(Irow,Icol).Value=.Fields(Icol-1).Name
　　Case2"將數(shù)組FIELDLEN()存為第一條記錄的字段長

　　IfIsNull(.Fields(Icol-1))=TrueThen
　　　　Fieldlen(Icol)=LenB(.Fields(Icol-1).Name)
　　　　　"如果字段值為NULL,則將數(shù)組Filelen(Icol)的值設(shè)為標題名的寬度
　　Else
　　　　Fieldlen(Icol)=LenB(.Fields(Icol-1))
　　EndIf

　　xlSheet.Columns(Icol).ColumnWidth=Fieldlen(Icol)
　　　"Excel列寬等于字段長
　　xlSheet.Cells(Irow,Icol).Value=.Fields(Icol-1)
　　　"向Excel的CellS中寫入字段值
　　CaseElse
　　Fieldlen1=LenB(.Fields(Icol-1))

　　IfFieldlen(Icol)<Fieldlen1Then
　　xlSheet.Columns(Icol).ColumnWidth=Fieldlen1
　　　"表格列寬等于較長字段長
　　Fieldlen(Icol)=Fieldlen1
　　　"數(shù)組Fieldlen(Icol)中存放最大字段長度值
　　Else
　　　xlSheet.Columns(Icol).ColumnWidth=Fieldlen(Icol)
　　EndIf

　　xlSheet.Cells(Irow,Icol).Value=.Fields(Icol-1)
　　EndSelect
　　Next
　　IfIrow<>1Then
　　IfNot.EOFThen.MoveNext
　　EndIf
　　Next
　　WithxlSheet
　　.Range(.Cells(1,1),.Cells(1,Icol-1)).Font.Name="黑體"
　　　"設(shè)標題為黑體字
　　.Range(.Cells(1,1),.Cells(1,Icol-1)).Font.Bold=True
　　　"標題　　EndWith

本程序在中文Windows98、中文VB5下通過。->