一区二区三区日韩精品-日韩经典一区二区三区-五月激情综合丁香婷婷-欧美精品中文字幕专区

分享

誰(shuí)知道怎么調(diào)用EXCEL做報(bào)表?

 高高 2007-07-19
誰(shuí)知道怎么調(diào)用EXCEL做報(bào)表?
‘引用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)自己作好的報(bào)表模板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ě)入數(shù)據(jù)
                        tempxlSheet.Range("A1").Value = "test"
                        ‘一次性寫(xiě)入tempRs數(shù)據(jù)記錄集中的數(shù)據(jù)
                        tempxlSheet.Range("A1").CopyFromRecordset tempRS
                        ‘保存
                        tempxlApp.save
                        ‘釋放對(duì)象
                        Set tempxlSheet = Nothing
                        Set tempxlWorkbook = Nothing
                        ‘關(guān)閉excel
                        tempxlApp.Quit
                        ‘千萬(wàn)別忘記寫(xiě)下面這一句,否則excel進(jìn)程不會(huì)關(guān)閉
                        Set tempxlApp = Nothing
                        
Top
回復(fù)人: y97523szb() ( ) 信譽(yù):100 2002-04-26 05:30:50Z 得分:10
icy_csdn() 的程序差不多
                        不過(guò)用前首先在自己的程序的引用中將Excel(office)的對(duì)象引用
                        關(guān)于Excel對(duì)象的資料你可以在Excel的幫助中找到(打開(kāi)Excel,從宏菜單中啟動(dòng)VBA編輯器,那是一個(gè)office中的VB,F1就可以調(diào)出幫助)
                        主要就是幾個(gè)對(duì)象:
                        Application
                        Workbook
                        Worksheet
                        別忘了給分:)
                        
Top
回復(fù)人: 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")
                        ‘按控件的內(nèi)容賦值
                        ‘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
                        ‘計(jì)算賦值
                        exsheet.Cells(13, 1).Formula = "=R9C4 + R9C5"
                        ‘設(shè)置字體
                        Dim exRange As Object
                        Set exRange = exsheet.Cells(13, 1)
                        exRange.Font.Bold = True
                        ‘設(shè)置一行為18號(hào)字體加黑
                        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
                        ‘設(shè)置斜體
                        Range("E2").Select
                        Selection.Font.Italic = True
                        ‘設(shè)置下劃線
                        Range("E3").Select
                        Selection.Font.Underline = xlUnderlineStyleSingle
                        ‘設(shè)置列寬為15
                        Selection.ColumnWidth = 15
                        ‘設(shè)置一片數(shù)據(jù)居中
                        Range("C4:G7").Select
                        With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .ShrinkToFit = False
                        .MergeCells = False
                        End With
                        ‘設(shè)置某區(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)"
                        ‘某列自動(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
                        ‘設(shè)置某單元格格式為文本
                        Range("E11").Select
                        Selection.NumberFormatLocal = "@"
                        ‘設(shè)置單元格格式為數(shù)值
                        Range("F10").Select
                        Selection.NumberFormatLocal = "0.000_);(0.000)"
                        ‘設(shè)置單元格格式為時(shí)間
                        Range("F11").Select
                        Selection.NumberFormatLocal = "h:mm AM/PM"
                        ‘取消選擇
                        Range("C10").Select
                        ‘設(shè)置橫向打印,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
                        ‘釋放對(duì)象
                        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.", "", 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
回復(fù)人: dbcontrols(泰山__拋磚引玉) ( ) 信譽(yù):被封殺 2002-04-26 06:47:17Z 得分:10
cgh1970() :復(fù)制我的代碼就算了,怎么連我的郵箱也列出來(lái)???
                        :P
                        
Top
回復(fù)人: setfocus(斗是懂一點(diǎn)) ( ) 信譽(yù):100 2002-04-26 08:30:33Z 得分:10
哈哈哈!搞笑呀!搜索一下帖子吧!原來(lái)有很多!
                        
Top
回復(fù)人: _1_(到j(luò)inesc.6600.org來(lái)找我) ( ) 信譽(yù):100 2002-04-26 08:35:29Z 得分:20
我也來(lái)貼一個(gè),  不太復(fù)雜的 , 就是非常的長(zhǎ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
                        ‘表頭
                        ‘公司名稱
                        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
                        ‘公司標(biāo)記
                        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根線
                        .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
                        ‘表頭公司名稱制作完畢
                        ‘下面開(kāi)始做發(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ā)票號(hào)
                        .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
回復(fù)人: _1_(到j(luò)inesc.6600.org來(lái)找我) ( ) 信譽(yù):100 2002-04-26 08:36:01Z 得分:0
‘明細(xì)內(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ù)量 單價(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)
                        ‘商品名稱
                        .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
                        ‘?dāng)?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
                        ‘明細(xì)內(nèi)容結(jié)束 畫(huà)結(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ā)個(gè)長(zhǎng)代碼來(lái)看看
                        
Top
用VB控制EXCEL生成報(bào)表
                        做為一種簡(jiǎn)捷、系統(tǒng)的 Windows應(yīng)用程序開(kāi)發(fā)工具,Visual Basic 5 具有強(qiáng)大的數(shù)據(jù)處理功能,提供了多種數(shù)據(jù)訪問(wèn)方法,可以方便地存取
Microsoft SQL Server、Oracle、XBase等多種數(shù)據(jù)庫(kù),被廣泛應(yīng)用于建立各種信息管理系統(tǒng)。但是,VB缺乏足夠的、符合中文習(xí)慣的數(shù)據(jù)表格輸出功能,
雖然使用Crystal Report控件及 Crystal Reports程序可以輸出報(bào)表,但操作起來(lái)很麻煩,中文處理能力也不理想。Excel作為Micorsoft公司的表格處
理軟件在表格方面有著強(qiáng)大的功能,我們可用VB5編寫(xiě)直接控制Excel操作的程序,方法是用VB的OLE自動(dòng)化技術(shù)獲取Excel 97 的控制句柄,從而直接控制
Excel 97的一系列操作。
                        下面給出一個(gè)實(shí)例:
                        首先建立一個(gè)窗體(FORM1)在窗體中加入一個(gè)DATA控件和一按鈕,
                        引用Microsoft Excel類型庫(kù):
                        從"工程"菜單中選擇"引用"欄;
                        選擇Microsoft Excel 8.0 Object Library;
                        選擇"確定"。
                        在FORM的LOAD事件中加入:
                          Data1.DatabaseName = 數(shù)據(jù)庫(kù)名稱
                          Data1.RecordSource = 表名
                          Data1.Refresh
                        在按鈕的CLICK事件中加入
                          Dim Irow, Icol As Integer
                          Dim Irowcount, Icolcount As Integer
                          Dim Fieldlen() "存字段長(zhǎ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 "記錄總數(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中的第一行加標(biāo)題
                          xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
                          Case 2 "將數(shù)組FIELDLEN()存為第一條記錄的字段長(zhǎng)
                          If IsNull(.Fields(Icol - 1)) = True Then
                            Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
                             "如果字段值為NULL,則將數(shù)組Filelen(Icol)的值設(shè)為標(biāo)題名的寬度
                          Else
                            Fieldlen(Icol) = LenB(.Fields(Icol - 1))
                          End If
                          xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
                           "Excel列寬等于字段長(zhǎ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
                           "表格列寬等于較長(zhǎng)字段長(zhǎng)
                          Fieldlen(Icol) = Fieldlen1
                           "數(shù)組Fieldlen(Icol)中存放最大字段長(zhǎ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 = "黑體"
                           "設(shè)標(biāo)題為黑體字
                          .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
                           "標(biāo)題字體加粗
                          .Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
                           "設(shè)表格邊框樣式
                          End With
                          xlApp.Visible = True "顯示表格
                          xlBook.Save "保存
                          Set xlApp = Nothing "交還控制給Excel
                          End With
                        

    本站是提供個(gè)人知識(shí)管理的網(wǎng)絡(luò)存儲(chǔ)空間,所有內(nèi)容均由用戶發(fā)布,不代表本站觀點(diǎn)。請(qǐng)注意甄別內(nèi)容中的聯(lián)系方式、誘導(dǎo)購(gòu)買等信息,謹(jǐn)防詐騙。如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容,請(qǐng)點(diǎn)擊一鍵舉報(bào)。
    轉(zhuǎn)藏 分享 獻(xiàn)花(0

    0條評(píng)論

    發(fā)表

    請(qǐng)遵守用戶 評(píng)論公約

    類似文章 更多

    人妻巨大乳一二三区麻豆| 最好看的人妻中文字幕| 国产丝袜极品黑色高跟鞋| 欧美日韩国产综合在线| 最近的中文字幕一区二区| 精品一区二区三区不卡少妇av| 日本加勒比在线观看不卡| 国产情侣激情在线对白| 国产欧美韩日一区二区三区| 国产色一区二区三区精品视频 | 四季av一区二区播放| 日韩三极片在线免费播放| 激情内射亚洲一区二区三区| 国产精品一区二区视频大全| 久久精品蜜桃一区二区av| 国产熟女一区二区精品视频| 国产精品视频一区二区秋霞| 日本高清不卡在线一区| 一区二区三区国产日韩| 色丁香一区二区黑人巨大| 黄色国产精品一区二区三区| 国产高清精品福利私拍| 九九热精品视频在线观看| 日本福利写真在线观看| 日韩成人h视频在线观看| 久久99一本色道亚洲精品| 国产精品久久熟女吞精| 欧美日韩精品综合在线| 我想看亚洲一级黄色录像| 男女午夜在线免费观看视频| 丝袜诱惑一区二区三区| 99久免费精品视频在线观| 日韩色婷婷综合在线观看| 国产精品福利一二三区| 五月婷婷六月丁香狠狠| 精品视频一区二区不卡| 老司机激情五月天在线不卡| 日韩欧美一区二区久久婷婷| 中文人妻精品一区二区三区四区| 免费黄色一区二区三区| 中文字幕五月婷婷免费|