VB中把数据导出到EXCEL的程序代码-vb导出excel,vb保存内容到excel

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

'--------------------------------------------------------------------------
'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
'****************************************Excel***************************************
Private Sub Record_Click()
Dim i As Integer
'Excel的各项定义及相关显示记录
Dim objExl As Excel.Application '声明对象变量
Me.MousePointer = 11 '改变鼠标样式
Set objExl = New Excel.Application '初始化对象变量
objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1
objExl.Workbooks.Add '增加一个工作薄
objExl.Sheets(objExl.Sheets.Count).Name = "book1" '修改工作薄名称
objExl.Sheets("book1").Select
objExl.Selection.NumberFormatLocal = "@" '设置格式为文本
objExl.Cells(1, 1).Value = "时间(Min)"
objExl.Cells(1, 2).Value = "电压1(V)"
objExl.Cells(1, 3).Value = "电流1(A)"
objExl.Cells(1, 4).Value = "温度1('C)"
objExl.Cells(1, 5).Value = "SOC1"
objExl.Cells(1, 6).Value = "电压2(V)"
objExl.Cells(1, 7).Value = "电流2(A)"
objExl.Cells(1, 8).Value = "温度2('C)"
objExl.Cells(1, 9).Value = "SOC2"

objExl.Rows("1:1").Select '选中第一行e79fa5e98193e58685e5aeb9330
objExl.Selection.Font.Bold = True '设为粗体
objExl.Selection.Font.Size = 14 '设置字体大小
objExl.Cells.EntireColumn.AutoFit '自动调整列宽

For i = 0 To UBound(Diyilu)
objExl.Cells(i + 2, 1).Value = 3 * i + 3
objExl.Cells(i + 2, 2).Value = Diyilu(i)
objExl.Cells(i + 2, 5).Value = Soc1(i)
objExl.Cells(i + 2, 6).Value = Dierlu(i)

Next

objExl.Visible = True '使EXCEL可见
objExl.DisplayAlerts = True '关闭时提示保存
Me.MousePointer = 0 '修改鼠标

Set objExl = Nothing '清除对象
' objExl.Quit '关闭EXCE
End Sub

自己做的一个Excel，看完应该就会了吧

准备工作，引用EXCEL11.0，与一个grid1控件和一个adodc1控件。
'以下为导出e79fa5e98193e59b9ee7ad94334EXCEL
'以下放到form中去。
Adodc1.connectionstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pmdb.mdb;Persist Security Info=False" '设置数据库路径
Adodc1.CommandType = adCmdText '设置记录源
Adodc1.RecordSource = "select * from new ORDER BY 好友姓名"
Set Grid1.DataSource = Adodc1
'以下放到代码框的最前面。
Private Sub toexcel()
On Error GoTo aa:
Dim i, j As Integer
Dim ex As Object
Dim exwbook As Object
Dim exsheet As Object
Set ex = CreateObject("Excel.Application") '创建EXCEL对象
Set exwbook = ex.Workbooks.Add '打开文件
ex.Visible = True
Set exsheet = exwbook.Worksheets("sheet1") '设定工作表
For i = 1 To Grid1.Rows
For j = 1 To Grid1.Cols - 1
exsheet.Cells(i, j) = Grid1.TextMatrix(i - 1, j)
Next j
Next i
aa:
Exit Sub
End Sub
'以下放到一个导出按钮上去就行了。
Call toexcel