作者：乔山办公网日期：
返回目录：excel表格制作
首先要确定SQL语句的运行环境。以下是VB里的数据导出代码，已假设创建了一个636f7079e799bee5baa6363adodc控件：
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") '设定工作表
With Adodc1.Recordset
For j = 2 To .Fields.Count
exsheet.Cells(1, 1) = "序号"
exsheet.Cells(1, j) = .Fields(j - 1).Name
Next
.MoveFirst
For i = 1 To .RecordCount
For j = 2 To .Fields.Count
exsheet.Cells(i + 1, 1) = i
exsheet.Cells(i + 1, j) = .Fields(j - 1).Value
Next
.MoveNext
Next i
End With
用下面e799bee5baa6e79fa5e98193e59b9ee7ad94331这段代码，根据自己实际修改一下就好
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
If Adodc1.Recordset.RecordCount > 0 Then
xlApp.Visible = True
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Merge
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)) = "未发料统计表"
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).HorizontalAlignment = xlCenter
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).VerticalAlignment = xlCenter
'xlSheet.Cells(1, 9) = "未发料统计表"
For i = 0 To TDBGrid1.Columns.Count - 1
xlSheet.Cells(2, i + 1) = TDBGrid1.Columns(i).Caption
Next i
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
i = Adodc1.Recordset.AbsolutePosition
For j = 0 To TDBGrid1.Columns.Count - 1
xlSheet.Cells(i + 2, j + 1) = TDBGrid1.Columns(j)
Next j
Adodc1.Recordset.MoveNext
Loop
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i + 2, j)).Borders.LineStyle = xlContinuous
End If
End Sub
导出语句的格式都是死的。。就那些语句。我给你我做的项目的语句你参考一下吧。
其中一些东西自己改一下就能用了。
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
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
'.........................................
'以上这些 都是我表里的字段名。
'下面我是用了一个循环把表里的数据写到EXCEL中。
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("矿浆浓度")
xlSheet.Cells(a, b + 5) = Adodc1.Recordset("矿浆流量")
xlSheet.Cells(a, b + 6) = Adodc1.Recordset("酸1开度")
xlSheet.Cells(a, b + 7) = Adodc1.Recordset("酸1瞬时流量")
xlSheet.Cells(a, b + 8) = Adodc1.Recordset("酸1累计流量")
xlSheet.Cells(a, b + 9) = Adodc1.Recordset("酸2开度")
xlSheet.Cells(a, b + 10) = Adodc1.Recordset("酸2瞬时流量")
xlSheet.Cells(a, b + 11) = Adodc1.Recordset("酸2累计流量")
xlSheet.Cells(a, b + 12) = Adodc1.Recordset("酸3开度")
xlSheet.Cells(a, b + 13) = Adodc1.Recordset("酸3瞬时流量")
xlSheet.Cells(a, b + 14) = Adodc1.Recordset("酸3累计流量")
xlSheet.Cells(a, b + 15) = Adodc1.Recordset("酸4开度")
xlSheet.Cells(a, b + 16) = Adodc1.Recordset("酸4瞬时流量")
xlSheet.Cells(a, b + 17) = Adodc1.Recordset("酸4累计流量")
xlSheet.Cells(a, b + 18) = Adodc1.Recordset("酸5开度")
xlSheet.Cells(a, b + 19) = Adodc1.Recordset("酸5瞬时流量")
xlSheet.Cells(a, b + 20) = 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
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 '因为第一条记录还未导出所以让指针回滚；e799bee5baa6e997aee7ad94e59b9ee7ad94332
rs.MovePrevious
End If
Next
xlApp.Visible = True
xlBook.Save
Set xlApp = Nothing
Sub dataToExcel()
Dim conn As String
Dim rs As New ADODB.Recordset
Dim excel As Object
Dim workbook As Object
Dim sheet As Object
Dim i&, j&
'SQL数据库的连636f7079e799bee5baa6e997aee7ad94361接字串
conn = "Provider=SQLOLEDB.1;Data source=服务器地址;initial catalog=数据库名称;User Id=数据库登录账号;Password=数据库登录账号"
'打开到sql的连接，读取xxx表数据到rs
rs.Open "select * from xxx", conn, adOpenKeyset, adLockReadOnly
'excel对象、工作簿、工作表
Set excel = CreateObject("Excel.Application")
Set workbook = excel.workbooks().Add()
Set sheet = workbook.sheets(1)
excel.Visible = True
'循环读取rs并写入到excel
For i = 1 To rs.Fields.Count
j = 1
rs.MoveFirst
Do While Not rs.EOF
sheet.cells(j, i) = rs.Fields(i - 1).Value
rs.MoveNext
j = j + 1
Loop
Next
rs.Close
Set rs = Nothing
End Sub