VB导出到EXCEL文件

Case 4
ToExcelJingChang.ToExcelJingChang xlbook, xls
Case 5
ToExcelJDanJia.ToExcelJDanJia xlbook, xls
'***************************写入内容*************************
Dim i As Integer
i = 3 'i控制行
Dim j As Integer 'j控制列
Dim countpage As Integer
Case 6
ToExcelADanJia.ToExcelADanJia xlbook, xls
End Select
End If
Next
xlbook.SaveAs Text1.Text '保存EXCEL文件
Select Case i
Case 0
ToExcelMan.ToExcelMan xlbook, xls
Case 1
ToExcelFSD_CL.ToExcelFSD_CL xlbook, xls
'On Error GoTo exlError
Dim i As Integer
If Dir(Text1.Text) <> "" Then '此目录下如有同名文件给出提示,并作相应处理
If MsgBox("文件已存在，是否覆盖！", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then
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.Cells(1, 1).Font.Size = 14
xlsheet.Cells(1, 1).Font.Bold = True
xlsheet.Rows(2).RowHeight = 18
xlsheet.Rows(2).HorizontalAlignment = xlHAlignCenter
xlsheet.Columns("c:j").ColumnWidth = 10
xlsheet.Columns("c:j").NumberFormatLocal = "0.00_ " '3到10列保留两位小数
'***************************写入标头*************************************
Case 2
ToExcelHNT.ToExcelHNT xlbook, xls
Case 3
ToExcelZsf.ToExcelZsf xlbook, xls
con.Open
rst_gcl.Open "zonggcl", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开工程量汇总表
If Not (rst_gcl.BOF And rst_gcl.EOF) Then
rst_gcl.MoveFirst
xlsheet.Cells(2, 1).Value = "序号"
xlsheet.Cells(2, 2).Value = "工程项目及名称"
xlsheet.Cells(2, 3).Value = "土方开挖(m3)"
xlsheet.Cells(2, 4).Value = "石方开挖(m3)"
Exit Sub
Else
Kill (Text1.Text) '删除文件
End If
End If
'************打开工作表***************
Set xls = New excel.Application
xlsheet.Rows(1).RowHeight = 40
xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 10)).MergeCells = True
xlsheet.Cells(1, 1).Value = "工程量汇总"
VB导出到EXCEL文件
所属类别：VB
推荐指数：★★★☆
文档人气：3160
本周人气：11
发布日期：2007-3-26
Private Sub cmdSwatch_Click()
Dim xls As excel.Application
Dim xlbook As excel.Workbook
con.CursorLocation = adUseClient
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"
xls.Visible = True
Set xlbook = xls.Workbooks.Add
'*********************************
For i = 0 To 14
If Check2(i).Value = vbChecked Then
xlsheet.Cells(2, 9).Value = "砌石工程(m3)"
xlsheet.Cells(2, 10).Value = "灌浆工程(m)"
xls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$2" '固定表头
10
ToExcelCailiao.ToExcelCailiao xlbook, xls
Case 11
ToExcelTsf.ToExcelTsf xlbook, xls
Select Case i
Case 8
ToExcelJDanJiaSum.ToExcelJDanJiaSum xlbook, xls
Case 9
ToExcelADanJiaSum.ToExcelADanJiaSum xlbook, xls
xlsheet.Cells(2, 5).Value = "土方回填(m3)"
xlsheet.Cells(2, 6).Value = "洞挖石方(m3)"
xlsheet.Cells(2, 7).Value = "砼浇筑(m3)"
xlsheet.Cells(2, 8).Value = "钢筋制安(t)"
Set xls = Nothing
Exit Sub
'exlError:
' MsgBox Err.Description, vbOKOnly + vbCritical, "警告"
End Sub
Option Explicit
Public Sub ToExcelZgcl(ByRef xlbook, ByRef xls) '输出总工程量
Next
'每18行为一页，如果数据超出一页时进行特殊处理
If i > 18 Then
xls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行
Case 12
ToExcelZgcl.ToExcelZgcl xlbook, xls
End Select
End If
Next
For i = 0 To 6
If Check3(i).Value = vbChecked Then
'***************************关闭EXCEL对象*******************
If Check1.Value = vbChecked Then
xlbook.Close
xls.Quit
End If
Set xlbook = Nothing
xlsheet.Columns(1).ColumnWidth = 8
xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft
xlsheet.Columns(2).ColumnWidth = 26
xlsheet.Columns("c:j").HorizontalAlignment = xlHAlignRight
Dim con As New ADODB.Connection