引用Microsoft Excel 9.0 Object LibraryDim a As Excel.Application Set a = New Excel.Application a.Visible = True a.workbooks.Add
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 Rs_Dzgl_Receipt If .RecordCount < 1 Then MsgBox ("没有记录!") Exit Sub End If xlSheet.Cells(1, 4).Value = .Fields("bt") xlSheet.Cells(2, 1).Value = .Fields("invoice") xlSheet.Cells(2, 9).Value = .Fields("packdate") xlSheet.Cells(3, 1).Value = .Fields("")
'合并单元格 Dim nIcol As Integer
xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select With xlApp.Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = True End With
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select With xlApp.Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = True End With '网格线 With xlSheet .Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体" '设标题为黑体字 .Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True '标题字体加粗 .Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous '设表格边框样式 End With
'显示表格 Dim ExclFileName As String ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls" If Dir(ExclFileName) <> "" Then Kill ExclFileName End If xlSheet.SaveAs (ExclFileName) xlApp.Application.Visible = True '交还控制给Excel xlSheet.PrintPreview ' xlApp.Application.Quit ' xlApp.Quit End With
exce.Workbooks.Open "C:\Downloads\人员简历.xls"
exce.Visible = True
Set exce = Nothing
========================
这只是打开一个EXCEL文件,至于怎么操纵EXCEL,你可以到EXCEL里边录制宏,看看详细的语句。
Set a = New Excel.Application
a.Visible = True
a.workbooks.Add
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 Rs_Dzgl_Receipt
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Sub
End If
xlSheet.Cells(1, 4).Value = .Fields("bt")
xlSheet.Cells(2, 1).Value = .Fields("invoice")
xlSheet.Cells(2, 9).Value = .Fields("packdate")
xlSheet.Cells(3, 1).Value = .Fields("")
'合并单元格
Dim nIcol As Integer
xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select
With xlApp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select
With xlApp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
'网格线
With xlSheet
.Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With
'显示表格
Dim ExclFileName As String
ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls"
If Dir(ExclFileName) <> "" Then
Kill ExclFileName
End If
xlSheet.SaveAs (ExclFileName)
xlApp.Application.Visible = True
'交还控制给Excel
xlSheet.PrintPreview
' xlApp.Application.Quit
' xlApp.Quit
End With