從"工程"菜單中選擇"引用"欄；選擇Microsoft Excel 9.0 Object Library（Excel2000），然后選擇"確定"。表示在工程中要引用Excel類型庫。
Dim xlApp As Excel.Application
Dim xlBook As Excel.WorkBook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application") '創(chuàng)建Excel對(duì)象
Set xlBook = xlApp.Workbooks.Open("文件名") '打開已經(jīng)存在的Excel工件簿文件
xlApp.Visible = True '設(shè)置Excel對(duì)象可見（或不可見）
Set xlSheet = xlBook.Worksheets("表名") '設(shè)置活動(dòng)工作表
xlSheet.Cells(row, col) =值 '給單元格（row,col）賦值
xlSheet.PrintOut '打印工作表
xlBook.Close (True) '關(guān)閉工作簿
xlApp.Quit '結(jié)束Excel對(duì)象
Set xlApp = Nothing '釋放xlApp對(duì)象
xlBook.RunAutoMacros (xlAutoOpen) '運(yùn)行Excel啟動(dòng)宏
xlBook.RunAutoMacros (xlAutoClose) '運(yùn)行Excel關(guān)閉宏
----------------------------
宏代碼：
"bb.xls"中打開Visual Basic編輯器，在工程窗口中點(diǎn)鼠標(biāo)鍵選擇插入模塊，在模塊中輸入入下程序存盤：
Sub auto_open()
Open "d:\Excel.bz" For Output As #1 '寫標(biāo)志文件
Close #1
End Sub
Sub auto_close()
Kill "d:\Excel.bz" '刪除標(biāo)志文件
End Sub
----------------------
|
|
|
| 60.4.111.* |
4樓
___________________
常用語法
xlsheet.Range("A1:I1").Select '選中A1至I1
xlapp.Selection.Merge '合并選中的
xlapp.Selection.HorizontalAlignment = xlCenter '水平居中
啟動(dòng) Excel
Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True'設(shè)置EXCEL對(duì)象可見（或不可見）
創(chuàng)建有一個(gè)工作表的工作簿
Dim objWorkBook As Excel.WorkBook
objExcel.SheetsInNewWorkbook = 1
Set objWorkbook = objExcel.Workbooks.Add
打開已經(jīng)存在的 EXCEL 工件簿文件
Set objWorkbook=objExcel.Workbooks.Open("文件名")
設(shè)置活動(dòng)工作表
Dim objSheet As Excel.Worksheet
Set objSheet = objExcel.Worksheets("表名")
給單元格（row,col）賦值
objSheet.Cells(row, col) =值
給合并的單元格賦值，如（A3：A9）
objSheet.Range("A3:A9") =值
運(yùn)行 EXCEL 宏
objWorkbook.RunAutoMacros ("宏名")
插入一行
objSheet.Rows("1:1").Insert Shift:=xlDown
Range("C8").Select
Selection.EntireRow.Insert '在第8行插入
Range("C9").Select
Selection.EntireRow.Delete '刪除第9行
range("a1:c3").copy'復(fù)制一塊
range("a5").PasteSpecial'在第a5行處粘貼復(fù)制的塊
xlSheet.Range("C3").Value = "1"
xlSheet.Cells(1, 1) = "test中文" '給單元格（row,col）賦值
' 畫邊框線
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(2, 2)).Borders.LineStyle = xlContinuous
xlSheet.Rows(1).HorizontalAlignment = xlVAlignCenter '左右居中
xlSheet.Rows(1).VerticalAlignment = xlVAlignCenter '上下居中
xlSheet.Cells(iStartRow + idx, 2).HorizontalAlignment = xlVAlignCenter '左右居中
'設(shè)置指定列的寬度(單位：字符個(gè)數(shù))
xlApp.ActiveSheet.Columns(1).ColumnWidth = 15
'設(shè)置指定行的高度(單位：磅)
xlApp.ActiveSheet.Rows(1).RowHeight = 1 / 0.035
'設(shè)置字體
'xlApp.ActiveSheet.Cells(1, 1).Font.Name = "黑體"
'設(shè)置字體大小
xlApp.ActiveSheet.Cells(1, 1).Font.Size = 25
'設(shè)置整列字體為粗體
xlApp.ActiveSheet.Columns(1).Font.Bold = True
'xlBook.SaveAs ("C:\Case1.xls")
'xlSheet.PrintPreview (True)
xlApp.Visible = True '顯示文件
'xlSheet.PrintOut '打印工作表
xlSheet.PageSetup.LeftHeader = "&""黑體,加粗""&36頁眉"'設(shè)為36號(hào)字體,黑體，加粗'設(shè)置頁眉
|
|
|
| 60.4.111.* |
5樓
一個(gè)打印課程表的例子
Option Explicit
Dim i, l As Integer
Dim n, k As Integer '表格和內(nèi)容的起始行
Dim yjhs As Integer '頁間間隔行數(shù)
Dim weizhi As String
Dim xlApp As Excel.Application '定義Excel類
Dim xlBook As Excel.Workbook '定義工件簿類
Dim xlsheet As Excel.Worksheet '定義工作表類
Dim strSource, strDestination As String
Private Sub Command1_Click() '打開Excel過程
wjcopy
If Dir("d:\Excel.bz") = "" Then '判斷Excel是否打開
Set xlApp = CreateObject("Excel.Application") '創(chuàng)建Excel應(yīng)用類
xlApp.Visible = True '設(shè)置Excel可見
Set xlBook = xlApp.Workbooks.Open(weizhi & "\臨時(shí)文件.xls") '打開Excel工作簿
Set xlsheet = xlBook.Worksheets(1) '打開Excel工作表
xlsheet.Activate '激活工作表
daochu '給單元格賦值
xlBook.Save '保存文件
xlBook.RunAutoMacros (xlAutoOpen) ' 運(yùn)行Excel中的啟動(dòng)宏
Else
MsgBox ("Excel已打開")
End If
End Sub
Private Sub Command3_Click()
If Dir("d:\Excel.bz") <> "" Then '由VB關(guān)閉Excel
xlBook.RunAutoMacros (xlAutoClose) '執(zhí)行Excel關(guān)閉宏
xlBook.Close (True) '關(guān)閉Excel工作簿
xlApp.Quit '關(guān)閉Excel
End If
Set xlApp = Nothing '釋放Excel對(duì)象
Unload Me
End
End Sub
Private Sub wjcopy()
On Error GoTo aa
strSource = weizhi & "\課程表.xls"
'RegisterFee.xls就是一個(gè)模版文件
strDestination = weizhi & "\臨時(shí)文件.xls"
'Kill strDestination
FileCopy strSource, strDestination
Exit Sub
aa:
MsgBox "創(chuàng)建臨時(shí)文件出錯(cuò)，可能是模板文件不存在，也可能是有其它程序占用引起的！"
End Sub
Private Sub daochu() '導(dǎo)入主表數(shù)據(jù)
If Cg1.FontName <> "" Then
xlApp.ActiveSheet.Cells(1, 1).Font.Name = Cg1.FontName
Else
xlApp.ActiveSheet.Cells(1, 1).Font.Name = "黑體"
End If
xlApp.ActiveSheet.Cells(1, 1).Font.Size = 18
xlsheet.Cells(1, 1) = Text1.Text
n = 0
k = 3
Dim l As Integer
l = 1
For n = 0 To 39
If n = 20 Then
k = k + 1
End If
If (n - 4) Mod 5 = 1 Then
k = k + 1
l = 1
End If
l = l + 1
xlsheet.Cells(k, l) = Combo1(n).Text
Next n
End Sub
Private Sub command2_Click()
wjcopy
If Dir("d:\Excel.bz") = "" Then '判斷Excel是否打開
Set xlApp = CreateObject("Excel.Application") '創(chuàng)建Excel應(yīng)用類
xlApp.Visible = False '設(shè)置Excel可見
Set xlBook = xlApp.Workbooks.Open(weizhi & "\臨時(shí)文件.xls") '打開Excel工作簿
Set xlsheet = xlBook.Worksheets(1) '打開Excel工作表
xlsheet.Activate '激活工作表
daochu '給單元格賦值
xlBook.Save '保存文件
xlsheet.PrintOut '打印表格
xlBook.RunAutoMacros (xlAutoOpen) ' 運(yùn)行Excel中的啟動(dòng)宏
Else
MsgBox ("Excel已打開,如果現(xiàn)在沒有打開，檢查D：\excel.bz這個(gè)文件是不是存在，刪除他。")
End If
End Sub
Private Sub Form_Load()
weizhi = App.Path
'weizhi = "d:\"
Dim i As Integer
For i = 0 To 39
Combo1(i).AddItem ("語文")
Combo1(i).AddItem ("數(shù)學(xué)")
Combo1(i).AddItem ("英語")
Combo1(i).AddItem ("歷史")
Combo1(i).AddItem ("地理")
Combo1(i).AddItem ("生物")
Combo1(i).AddItem ("社會(huì)")
Combo1(i).AddItem ("自然")
Combo1(i).AddItem ("政治")
Combo1(i).AddItem ("體育")
Combo1(i).AddItem ("物理")
Combo1(i).AddItem ("美術(shù)")
Combo1(i).AddItem ("音樂")
Combo1(i).AddItem ("自習(xí)")
Combo1(i).AddItem ("勞動(dòng)")
Combo1(i).AddItem ("自由")
Combo1(i).AddItem ("活動(dòng)")
Combo1(i).Text = "語文"
Next i
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Me
End
End Sub
Private Sub Image1_Click()
On Error GoTo aa:
Cg1.Flags = cdlCFScreenFonts Or cdlCFEffects
Cg1.ShowFont
If Cg1.FontSize > 24 Then Cg1.FontSize = 24
With Text1.Font
.Name = Cg1.FontName
.Size = Cg1.FontSize
.Bold = Cg1.FontBold
.Italic = Cg1.FontItalic
.Strikethrough = Cg1.FontStrikethru
.Underline = Cg1.FontUnderline
End With
xlApp.ActiveSheet.Cells(1, 1).Font.Name = Cg1.FontName
Exit Sub
aa:
End Sub
|
|
|
|
