Question

VB中把数据导出到EXCEL的程序代码

各位高手帮写一下VB中把查询所得数据导出到EXCEL的代码!非常感谢!

Answer 1

调用方法
ExcelPreview ListView1, "郝南仁测试"

'--------------------------------------------------------------------------
'listView 导出成EXECL
'--------------------------------------------------------------------------
Public Sub ExcelPreview(ListView1 As ListView, vstrCaption As String)

'-----------------------------------------------------------------------------------------------

Dim mobjExcel As Excel.Application
Dim mobjWorkBook As Excel.Workbook
Dim strListItem As String
Dim strCol As String
Dim lngMaxLine As Long '表格的行数
Dim i As Long
Dim j As Long
On Error GoTo Err1
strCol = Chr(Asc("a") + ListView1.ColumnHeaders.Count - 1) '表格的列
If ListView1.ListItems.Count = 0 Then Exit Sub
'FrmMain.CommonDialog1.Filter = "Excel (*.xls)|*.xls"
Set mobjExcel = New Excel.Application
With mobjExcel

.SheetsInNewWorkbook = 1
Set mobjWorkBook = .Workbooks.Add
.ActiveSheet.Cells(1, 1) = vstrCaption
For i = 1 To ListView1.ColumnHeaders.Count
.ActiveSheet.Cells(2, i) = ListView1.ColumnHeaders(i).Text
Next i
For i = 1 To ListView1.ListItems.Count
'-------------------------------------
'导出当前处理到那一条记录 [窗口2]
Form2.ProgressBar1.value = i
Form2.Label2.caption = i
strListItem = ListView1.ListItems(i).Text
.ActiveSheet.Cells(i + 2, 1).value = strListItem
For j = 1 To ListView1.ColumnHeaders.Count - 1
strListItem = ListView1.ListItems(i).SubItems(j)
.ActiveSheet.Cells(i + 2, j + 1).value = strListItem
Form2.Label2.caption = i & ":" & j
Next j
lngMaxLine = i + 2
Next i
End With
With mobjExcel.ActiveSheet
.Cells(1, 1).Font.Size = 18
.Cells(1, 1).HorizontalAlignment = xlVAlignCenter ' 居中
.Range("a1").Font.Bold = True
.Range("a1").RowHeight = 36
.Range("a2:" & strCol & "2").Font.Bold = True '粗体
.Range("a2:a" & lngMaxLine).Font.Bold = True
.Range("a1:" & strCol & "1").MergeCells = True '合并单元格
End With
With mobjExcel.ActiveSheet.Range("a2:" & strCol & lngMaxLine).Borders '加表格
.LineStyle = 0
.Weight = 2
End With
With mobjExcel
For i = 1 To ListView1.ColumnHeaders.Count '设置列宽
.ActiveSheet.Range(Chr(Asc("a") + i - 1) & "2").ColumnWidth = ListView1.ColumnHeaders(i).Width * 0.008
.ActiveSheet.Range("a1:" & strCol & lngMaxLine).HorizontalAlignment = xlVAlignCenter
Next i
End With
' With mobjExcel.ActiveSheet.PageSetup
' .TopMargin = 0.5 / 0.035 '设置页面边距
' .BottomMargin = 1 / 0.035
' .LeftMargin = 0.5 / 0.035
' .RightMargin = 0.5 / 0.035
' .CenterHorizontally = True '整页居中
' 'mobjWorkBook.SaveAs FrmMain.CommonDialog1.FileName'保存到硬盘
' .Orientation = xlPortrait 'xlLandscape'打印方向
' .PaperSize = xlPaperA3 '纸张大小
' End With
With mobjExcel
.caption = "打印预览" '设置预览窗口的 标题
.Visible = True '显示
' .ActiveSheet.PrintPreview
'.ActiveSheet.PrintOut'直接打印
.DisplayAlerts = False
'.Quit
End With
Set mobjExcel = Nothing
Form2.Hide
Exit Sub
Err1:
' 'MsgBox Err.Description & ":" & Err.Number, vbExclamation, "错误"
Set mobjExcel = Nothing
MsgBox err.Description
End Sub

Answer 2

可以直接把recordset记录集中的数据一次性复制到excel中的。

Answer 3

去我的博客看看吧，地址http://blog.csdn.net/xian827991006/archive/2009/08/08/4426142.aspx