|
|
|
‘引用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
‘打開自己作好的報表模板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
‘單個單元格寫入數(shù)據(jù)
tempxlSheet.Range("A1").Value = "test"
‘一次性寫入tempRs數(shù)據(jù)記錄集中的數(shù)據(jù)
tempxlSheet.Range("A1").CopyFromRecordset tempRS
‘保存
tempxlApp.save
‘釋放對象
Set tempxlSheet = Nothing
Set tempxlWorkbook = Nothing
‘關閉excel
tempxlApp.Quit
‘千萬別忘記寫下面這一句，否則excel進程不會關閉
Set tempxlApp = Nothing
|
| Top |
|
|
回復人： y97523szb() ( ) 信譽：100 |
2002-04-26 05:30:50Z |
得分:10 |
|
|
|
icy_csdn() 的程序差不多
不過用前首先在自己的程序的引用中將Excel（office)的對象引用
關于Excel對象的資料你可以在Excel的幫助中找到（打開Excel，從宏菜單中啟動VBA編輯器，那是一個office中的VB,F1就可以調(diào)出幫助）
主要就是幾個對象：
Application
Workbook
Worksheet
別忘了給分：）
|
| Top |
|
|
回復人： cgh1970(聊天別找我) ( ) 信譽：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")
‘按控件的內(nèi)容賦值
‘11
exsheet.Cells(1, 1).Value = Text1.Text
‘為同行的幾個格賦值
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
‘設置下劃線
Range("E3").Select
Selection.Font.Underline = xlUnderlineStyleSingle
‘設置列寬為15
Selection.ColumnWidth = 15
‘設置一片數(shù)據(jù)居中
Range("C4:G7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
‘設置某區(qū)域的小數(shù)位數(shù)
Range("F4:F7").Select
Selection.NumberFormatLocal = "0.00"
‘求和
Range("G9:G13").Select
Range("G13").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
‘某列自動縮放寬度
Columns("C:C").EntireColumn.AutoFit
‘畫表格
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 = "@"
‘設置單元格格式為數(shù)值
Range("F10").Select
Selection.NumberFormatLocal = "0.000_);(0.000)"
‘設置單元格格式為時間
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
‘ 關閉工作表。
exbook.Close
‘用 Quit 方法關閉 Microsoft Excel
ex.Quit
‘釋放對象
Set ex = Nothing
Set exbook = Nothing
Set exsheet = Nothing
Dim retval
‘用excel打開表格
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()
‘打開主頁
ret& = ShellExecute(Me.hwnd, "Open", "http://dyqing.", "", 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(泰山__拋磚引玉) ( ) 信譽：被封殺 |
2002-04-26 06:47:17Z |
得分:10 |
|
|
|
cgh1970() :復制我的代碼就算了，怎么連我的郵箱也列出來??？
:P
|
| Top |
|
|
回復人： setfocus(斗是懂一點) ( ) 信譽：100 |
2002-04-26 08:30:33Z |
得分:10 |
|
|
|
哈哈哈！搞笑呀！搜索一下帖子吧！原來有很多！
|
| Top |
|
|
回復人： _1_(到jinesc.6600.org來找我) ( ) 信譽：100 |
2002-04-26 08:35:29Z |
得分:20 |
|
|
|
我也來貼一個， 不太復雜的 ， 就是非常的長
屬于好玩 ，你看看吧~~~
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
‘表頭
‘公司名稱
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
‘公司電話
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
‘行高和畫2根線
.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
‘表頭公司名稱制作完畢
‘下面開始做發(fā)票資料
‘客戶資料
.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
‘表格割線
.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_(到jinesc.6600.org來找我) ( ) 信譽：100 |
2002-04-26 08:36:01Z |
得分:0 |
|
|
|
‘明細內(nèi)容的表頭
‘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
‘以下假如顯示內(nèi)容 主要是 商品名稱 規(guī)格 數(shù)量 單價 金額 單位
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)
‘商品名稱
.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
‘規(guī)格
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
‘數(shù)量
.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
‘明細內(nèi)容結(jié)束 畫結(jié)尾表格線
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
‘匯總數(shù)量和金額
.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ā)個長代碼來看看
|
| Top |
|
|
|
|
|
|
|
|
用VB控制EXCEL生成報表
做為一種簡捷、系統(tǒng)的 Windows應用程序開發(fā)工具，Visual Basic 5 具有強大的數(shù)據(jù)處理功能，提供了多種數(shù)據(jù)訪問方法，可以方便地存取
Microsoft SQL Server、Oracle、XBase等多種數(shù)據(jù)庫，被廣泛應用于建立各種信息管理系統(tǒng)。但是，VB缺乏足夠的、符合中文習慣的數(shù)據(jù)表格輸出功能，
雖然使用Crystal Report控件及 Crystal Reports程序可以輸出報表，但操作起來很麻煩，中文處理能力也不理想。Excel作為Micorsoft公司的表格處
理軟件在表格方面有著強大的功能，我們可用VB5編寫直接控制Excel操作的程序,方法是用VB的OLE自動化技術獲取Excel 97 的控制句柄,從而直接控制
Excel 97的一系列操作。
下面給出一個實例：
首先建立一個窗體（FORM1）在窗體中加入一個DATA控件和一按鈕，
引用Microsoft Excel類型庫:
從"工程"菜單中選擇"引用"欄;
選擇Microsoft Excel 8.0 Object Library;
選擇"確定"。
在FORM的LOAD事件中加入：
Data1.DatabaseName = 數(shù)據(jù)庫名稱
Data1.RecordSource = 表名
Data1.Refresh
在按鈕的CLICK事件中加入
Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen() "存字段長度值
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 沒有記錄!")
Exit Sub
End If
Irowcount = .RecordCount "記錄總數(shù)
Icolcount = .Fields.Count "字段總數(shù)
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 "將數(shù)組FIELDLEN()存為第一條記錄的字段長
If IsNull(.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
"如果字段值為NULL,則將數(shù)組Filelen(Icol)的值設為標題名的寬度
Else
Fieldlen(Icol) = LenB(.Fields(Icol - 1))
End If
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
"Excel列寬等于字段長
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
"向Excel的CellS中寫入字段值
Case Else
Fieldlen1 = LenB(.Fields(Icol - 1))
If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
"表格列寬等于較長字段長
Fieldlen(Icol) = Fieldlen1
"數(shù)組Fieldlen(Icol)中存放最大字段長度值
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
|
|
|
