返回目录：excel表格制作
Private Sub Command3_Click()
On Error Resume Next
Dim irow, icol, count, i As Integer
Dim irowcount, icolcount As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim bl As Boolean
Dim key As Integer
Dim RsUserTemp As Recordset
Dim RsOrderTemp As Recordset
Dim a, b
Dim aa As String
aa = Trim(Now)
Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
'If rs.RecordCount < 1 Then
'MsgBox ("Error 没有记录")
'Exit Sub
'End If
irowcount = rs.RecordCount
icolcount = 18
count = 0
rs.MoveFirst
For icol = 0 To 2
'xlSheet.Cells(1, 1).Value = "查询数据" '加标头；e68a84e8a2ade799bee5baa6e79fa5e98193337
Next icol
xlSheet.Cells(1, 1).Value = "时间" '加标头；
xlSheet.Cells(1, 2).Value = "药开度" '加标头；
xlSheet.Cells(1, 3).Value = "药瞬时流量" '加标头；
xlSheet.Cells(1, 4).Value = "药累计流量" '加标头；
xlSheet.Cells(1, 5).Value = "矿浆浓度" '加标头；
xlSheet.Cells(1, 6).Value = "矿浆流量" '加标头
xlSheet.Cells(1, 7).Value = "酸1开度" '加标头；
xlSheet.Cells(1, 8).Value = "酸1瞬时流量" '加标头；
xlSheet.Cells(1, 9).Value = "酸1累计流量" '加标头
xlSheet.Cells(1, 10).Value = "酸2开度" '加标头；
xlSheet.Cells(1, 11).Value = "酸2瞬时流量" '加标头；
xlSheet.Cells(1, 12).Value = "酸2累计流量" '加标头
xlSheet.Cells(1, 13).Value = "酸3开度" '加标头；
xlSheet.Cells(1, 14).Value = "酸3瞬时流量" '加标头；
xlSheet.Cells(1, 15).Value = "酸3累计流量" '加标头
xlSheet.Cells(1, 16).Value = "酸4开度" '加标头；
xlSheet.Cells(1, 17).Value = "酸4瞬时流量" '加标头；
xlSheet.Cells(1, 18).Value = "酸4累计流量"
xlSheet.Cells(1, 19).Value = "酸5开度"
xlSheet.Cells(1, 20).Value = "酸5瞬时流量"
xlSheet.Cells(1, 21).Value = "酸5累计流量"
Adodc1.Recordset.MoveFirst
For a = 2 To 200
b = 1
If Not Adodc1.Recordset.EOF Then
xlSheet.Cells(a, b) = Adodc1.Recordset("时间")
xlSheet.Cells(a, b + 1) = Adodc1.Recordset("药开度")
xlSheet.Cells(a, b + 2) = Adodc1.Recordset("药瞬时流量")
xlSheet.Cells(a, b + 3) = Adodc1.Recordset("药累计流量")
xlSheet.Cells(a, b + 4) = Adodc1.Recordset("酸1开度")
xlSheet.Cells(a, b + 5) = Adodc1.Recordset("酸1瞬时流量")
xlSheet.Cells(a, b + 6) = Adodc1.Recordset("酸1累计流量")
xlSheet.Cells(a, b + 7) = Adodc1.Recordset("酸2开度")
xlSheet.Cells(a, b + 8) = Adodc1.Recordset("酸2瞬时流量")
xlSheet.Cells(a, b + 9) = Adodc1.Recordset("酸2累计流量")
xlSheet.Cells(a, b + 10) = Adodc1.Recordset("酸3开度")
xlSheet.Cells(a, b + 11) = Adodc1.Recordset("酸3瞬时流量")
xlSheet.Cells(a, b + 12) = Adodc1.Recordset("酸3累计流量")
xlSheet.Cells(a, b + 13) = Adodc1.Recordset("酸4开度")
xlSheet.Cells(a, b + 14) = Adodc1.Recordset("酸4瞬时流量")
xlSheet.Cells(a, b + 15) = Adodc1.Recordset("酸4累计流量")
xlSheet.Cells(a, b + 16) = Adodc1.Recordset("酸5开度")
xlSheet.Cells(a, b + 17) = Adodc1.Recordset("酸5瞬时流量")
xlSheet.Cells(a, b + 18) = Adodc1.Recordset("酸5累计流量")
Else
Exit For
End If
Adodc1.Recordset.Move 1
Next
rs.MoveFirst
xlSheet.Cells(2, 2).Value = Trim(Text1.Text) & Trim(Text2.Text)
For irow = 0 To irowcount - 1
Set RsUserTemp = New Recordset
RsUserTemp.CursorLocation = adUseClient
RsUserTemp.Open "select * from 状态数据 " _
& "where user0_id=" & rs!user0_id, Cn, adOpenStatic, adLockReadOnly
xlSheet.Cells(irow + 4, 1).Value = count + 1
xlSheet.Cells(irow + 4, 2).Value = RsUserTemp!user0_id
xlSheet.Cells(irow + 4, 3).Value = RsUserTemp!user0_name
xlSheet.Cells(irow + 4, 4).Value = RsUserTemp!Address
xlSheet.Cells(irow + 4, 5).Value = RsUserTemp!callno1
Set RsUserTemp = Nothing
Set RsOrderTemp = New Recordset
RsOrderTemp.CursorLocation = adUseClient
RsOrderTemp.Open "select * from 状态数据 where user0_id = " _
If RsOrderTemp.RecordCount = 0 Then
Else
RsOrderTemp.MoveFirst
Do While (Not RsOrderTemp.EOF)
key = 0
key = Val(Mid(str(RsOrderTemp!Order_Time), 6, 2))
Select Case key
Case 0
Exit Do
Case 1
xlSheet.Cells(irow + 4, 6).Value = RsOrderTemp!Order_Amount
Case 2
xlSheet.Cells(irow + 4, 7).Value = RsOrderTemp!Order_Amount
Case 3
xlSheet.Cells(irow + 4, 8).Value = RsOrderTemp!Order_Amount
Case 4
xlSheet.Cells(irow + 4, 9).Value = RsOrderTemp!Order_Amount
Case 5
xlSheet.Cells(irow + 4, 10).Value = RsOrderTemp!Order_Amount
Case 6
xlSheet.Cells(irow + 4, 11).Value = RsOrderTemp!Order_Amount
Case 7
xlSheet.Cells(irow + 4, 12).Value = RsOrderTemp!Order_Amount
Case 8
xlSheet.Cells(irow + 4, 13).Value = RsOrderTemp!Order_Amount
Case 9
xlSheet.Cells(irow + 4, 14).Value = RsOrderTemp!Order_Amount
Case 10
xlSheet.Cells(irow + 4, 15).Value = RsOrderTemp!Order_Amount
Case 11
xlSheet.Cells(irow + 4, 16).Value = RsOrderTemp!Order_Amount
Case 12
xlSheet.Cells(irow + 4, 17).Value = RsOrderTemp!Order_Amount
End Select
RsOrderTemp.MoveNext
Loop
End If
Set RsOrderTemp = Nothing
count = count + 1
rs.MoveNext
If bl Then '因为第一条记录还未导出所以让指针回滚；
rs.MovePrevious
End If
Next
xlApp.Visible = True
xlBook.Save
Set xlApp = Nothing
End Sub
这是我的一个代码，参考一下吧。。。导出到EXCEL的 '百度Hi群&飞度编程学社 1195277
介绍
下面通过一步一步的介绍，如何通过VB.NET来读取数据，并且将数据导入到Excel中。
第一步：e799bee5baa6e997aee7ad94e59b9ee7ad94338
打开VS开发工具，并且添加引用。
然后选择。
Microsoft Excel 12.0 object library and。
Microsoft Excel 14.0 object library。
第二步：
创建一个Excle在你的电脑中。
第三步：
在VS中写入如下代码：
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel。
Public Class excel
‘添加按钮
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Button1.Click
Try
'创建连接
Dim cnn As DataAccess = New DataAccess(CONNECTION_STRING)
Dim i, j As Integer
'创建Excel对象
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
xlApp = New Microsoft.Office.Interop.Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
' 打开某一个表单
xlWorkSheet = xlWorkBook.Sheets("sheet1")
' sql查询
' xlWorkBook.Sheets.Select("A1:A2")
Dim sql As String = "SELECT * FROM EMP"
' SqlAdapter
Dim dscmd As New SqlDataAdapter(sql, cnn.ConnectionString)
' 定义数据集
Dim ds As New DataSet
dscmd.Fill(ds)
‘添加字段信息到Excel表的第一行
xlWorkSheet.Cells(1, 1).Value = "First Name"
xlWorkSheet.Cells(1, 2).Value = "Last Name"
xlWorkSheet.Cells(1, 3).Value = "Full Name"
xlWorkSheet.Cells(1, 4).Value = "Salary"
' 将数据导入到excel
For i = 0 To ds.Tables(0).Rows.Count - 1
'Column
For j = 0 To ds.Tables(0).Columns.Count - 1
' this i change to header line cells >>>
xlWorkSheet.Cells(i + 3, j + 1) = _
ds.Tables(0).Rows(i).Item(j)
Next
Next
'HardCode in Excel sheet
' this i change to footer line cells >>>
xlWorkSheet.Cells(i + 3, 7) = "Total"
xlWorkSheet.Cells.Item(i + 3, 8) = "=SUM(H2:H18)"
' 保存到Excel
xlWorkSheet.SaveAs("D:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
'弹出对话框显示保存后的路径
MsgBox("You can find the file D:\vbexcel.xlsx")
Catch ex As Exception
End Try
End Sub
' Function of Realease Object in Excel Sheet
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
复制代码。
第四步：
看到如下导出结果。
准备工作，引用EXCEL11.0，与一个grid1控件和一个adodc1控件。
'以下为导出EXCEL
'以下放到form中去。7a686964616fe4b893e5b19e334
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
调用方法
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 ' 居中e799bee5baa6e59b9ee7ad94332
.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