VB中使用EXCEL输出

Private Sub cmdSwatch_Click()

Dim xls As excel.Application

Dim xlbook As excel.Workbook

'On Error GoTo exlError

Dim i As Integer

If Dir(Text1.Text) <> "" Then '此目录下如有同名文件给出提示,并作相应处理

If MsgBox("文件已存在，是否覆盖！", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then Exit Sub

Else

Kill (Text1.Text) '删除文件

End If

End If

'************打开工作表***************

Set xls = New excel.Application

xls.Visible = True

Set xlbook = xls.Workbooks.Add

'*********************************

For i = 0 To 14

If Check2(i).Value = vbChecked Then

Select Case i

Case 8

ToExcelJDanJiaSum.ToExcelJDanJiaSum xlbook, xls

Case 9

ToExcelADanJiaSum.ToExcelADanJiaSum xlbook, xls

Case 10

ToExcelCailiao.ToExcelCailiao xlbook, xls

Case 11

ToExcelTsf.ToExcelTsf xlbook, xls

Case 12

ToExcelZgcl.ToExcelZgcl xlbook, xls

End Select

End If

Next

For i = 0 To 6

If Check3(i).Value = vbChecked Then

Select Case i

Case 0

ToExcelMan.ToExcelMan xlbook, xls

Case 1

ToExcelFSD_CL.ToExcelFSD_CL xlbook, xls Case 2

ToExcelHNT.ToExcelHNT xlbook, xls

Case 3

ToExcelZsf.ToExcelZsf xlbook, xls

Case 4

ToExcelJingChang.ToExcelJingChang xlbook, xls Case 5

ToExcelJDanJia.ToExcelJDanJia xlbook, xls Case 6

ToExcelADanJia.ToExcelADanJia xlbook, xls End Select

End If

Next

xlbook.SaveAs Text1.Text '保存EXCEL文件

'***************************关闭EXCEL对象*******************

If Check1.Value = vbChecked Then

xlbook.Close

xls.Quit

End If

Set xlbook = Nothing

Set xls = Nothing

Exit Sub

'exlError:

' MsgBox Err.Description, vbOKOnly + vbCritical, "警告"

End Sub

Option Explicit

Public Sub ToExcelZgcl(ByRef xlbook, ByRef xls) '输出总工程量

Dim con As New ADODB.Connection

Dim rst_gcl As New ADODB.Recordset

Dim rst_qm As New ADODB.Recordset

'**************************连接数据库****************************************

con.CursorLocation = adUseClient

con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"

con.Open

rst_gcl.Open "zonggcl", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开工程量汇总表

If Not (rst_gcl.BOF And rst_gcl.EOF) Then

rst_gcl.MoveFirst

End If

rst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开签名表

rst_qm.MoveFirst

'****************************工作表初使化*********************************** Dim xlsheet As excel.Worksheet

Set xlsheet = xlbook.Sheets.Add '添加一张工作表

= "工程量汇总"

xls.ActiveSheet.PageSetup.Orientation = xlLandscape '纸张设置为横向

xlsheet.Columns("a:j").Font.Size = 10

xlsheet.Columns("a:j").VerticalAlignment = xlVAlignCenter '垂直居中

xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐

xlsheet.Columns(1).ColumnWidth = 8

xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft

xlsheet.Columns(2).ColumnWidth = 26

xlsheet.Columns("c:j").HorizontalAlignment = xlHAlignRight

xlsheet.Columns("c:j").ColumnWidth = 10

xlsheet.Columns("c:j").NumberFormatLocal = "0.00_ " '3到10列保留两位小数

'***************************写入标头************************************* xlsheet.Rows(1).RowHeight = 40

xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 10)).MergeCells = True

xlsheet.Cells(1, 1).Value = "工程量汇总"

xlsheet.Cells(1, 1).Font.Size = 14

xlsheet.Cells(1, 1).Font.Bold = True

xlsheet.Rows(2).RowHeight = 18

xlsheet.Rows(2).HorizontalAlignment = xlHAlignCenter

xlsheet.Cells(2, 1).Value = "序号"