看我的通用模块代码:
Module PrintToExcel
'--秸ノよ猭
'--Dim Title As String
'--Title = "侗睲虫 Excel 厨"
'--Call App1.PrintToExcel.PrintToExcel(Title)
'*** A sub-proc to save the DataSet to Excel
Public Sub PrintToExcel(ByVal Title As String)
'--浪代Excel穝Excel癸禜
Dim xlsOb
Try
xlsOb = CreateObject("Excel.Application")
Catch ex As Exception
MsgBox("眤﹟ゼ杆Excel")
End Try
If xlsOb.Version > "9.0" Then
MsgBox("眤惠璶杆Excel2000セ")
xlsOb.Quit()
End If
'--﹚竡跑秖
Dim row As Integer
Dim col As Integer
With xlsOb
'--穝糤Excel
.Visible = True
.Caption = Title
.WORKBOOKS.ADD()
.SHEETS(1).SELECT()
.APPLICATION.WINDOWSTATE = 3
'--糤砞竚夹肈
.Range("A1") = Title
Dim i As Integer
Dim myCol, myStr As String
myStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
col = objDS.Tables(0).Columns.Count
myCol = myStr.Substring(col - 1, 1)
With .Range("A1:" & myCol & 1)
.Merge()
.HorizontalAlignment = 3
.VerticalAlignment = 2
.FONT.BOLD = True
.FONT.SIZE = 18
End With
If objDS.Tables(0).Rows.Count > 0 Then
'--糤夹肈砞竚夹肈糴蔨
'--Cells(x,y), Columns(y,x)
With objDS.Tables(0)
For col = 0 To .Columns.Count - 1
xlsOb.Cells(2, col + 1) = .Columns.Item(col).ColumnName
xlsOb.Cells(2, col + 1).FONT.BOLD = True
myCol = myStr.Substring(col, 1)
xlsOb.ActiveSheet.Columns(myCol).ColumnWidth = 10
Next
End With
'--糤タゅ
With objDS.Tables(0)
For row = 0 To .Rows.Count - 1
For col = 0 To .Columns.Count - 1
xlsOb.Cells(row + 1 + 2, col + 1) = objDS.Tables(0).Rows(row).Item(col)
Next
Next
End With
End If
'--砞竚タゅ
With .Range("A2:" & myCol & row + 2)
.Borders.Weight = 2 'ゴΤ絬
.HorizontalAlignment = 4 '2,3,4竚オい癸霍
.VerticalAlignment = 2 '1,2,3竚い癸霍
End With
'--秨﹍ゴ饼凝,Τゲ璶玂痙
'.ActiveSheet.PageSetup.PaperSize = 9 'A4
'.ActiveSheet.PageSetup.Orientation = 2 '绢
.ActiveSheet.PrintPreview()
End With
xlsOb = Nothing
End Sub
End Module