我想在VB中将SQL SERVER数据库表中的数据导出到EXCEl表中，请问如何实现？—

abc_2004
VBL
等级:

发表于：2008-07-04 12:16:431楼得分:10

On Error Resume Next
If MSFlexGrid1.TextMatrix(1, 2) = "" Then
MsgBox "没有数据导出", vbInformation, "提示"
Exit Sub
End If
Dim excelApp As Excel.Application
Set excelApp = New Excel.Application
Set excelApp = CreateObject("Excel.Application")
Dim exbook As Excel.Workbook
Dim exsheet As Excel.Worksheet
Set exbook = excelApp.Workbooks.Add
excelApp.SheetsInNewWorkbook = 1
excelApp.Visible = False '是否显示导出过程(true是)
excelApp.UserControl = True
Me.MousePointer = vbHourglass'控制鼠标为读取数据
'''''''''''''''''''''''''''''''''''''''''''表头设置'''''''''''''''''''''''''''''''''''''
With excelApp.ActiveSheet '表头合并
.Range("a1:b4").Merge '合并
.Range("c1:d2").Merge '合并
.Range("c3:d4").Merge '合并
.Range("e1:o2").Merge '合并
.Range("e3:o4").Merge '合并
.Range("c1:d2") = "制度名称"
.Range("c3:d4") = "表格名称"
.Range("e1:o2") = "生产成本统计"
.Range("e3:o4") = "产成品生产与成本统计月平均报表"
.Range("p1:p1") = "填表:"
.Range("p2:p2") = "审核:"
.Range("p3:p3") = "批准:"
.Range("p4:p4") = "归档部门:"
.Range("r1:r1") = "制度编号:"
.Range("r2:r2") = "制度版本:"
.Range("r3:r3") = "表格编号:"
.Range("r4:r4") = "表格版本:"
.rows.HorizontalAlignment = xlVAlignCenter'
End With
With excelApp.ActiveSheet
.Range("A1:s4").Borders.LineStyle = xlContinuous '表头边框线
End With
''''''''''''''''''''''''''''''''报表日期--
With excelApp.ActiveSheet
.Range("q5:q5") = "报表日期:" & Format$(Date, "yyyy-mm-dd")
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With excelApp.ActiveSheet

.Range("a6:a6") = "序号"
.Range("b6:b6") = ""
.Range("c6:c6") = "产品型号"
.Range("d6:d6") = "产品批号"
.Range("e6:e6") = "产品月批次"
.Range("f6:f6") = "实际产量"
.Range("g6:g6") = "实际金额"
.Range("h6:h6") = "实际进仓数量"
.Range("i6:i6") = "实际进仓金额"
.Range("j6:j6") = "车间存放量"
.Range("k6:k6") = "车间存放金额"
.Range("l6:l6") = "材料成本单价"
.Range("m6:m6") = "包装成本单价"
.Range("n6:n6") = "材包成本单价"
.Range("o6:o6") = "材包税成本"
.Range("p6:p6") = "损耗量"
.Range("q6:q6") = "损耗率"
.Range("r6:r6") = "产出率"
.Range("s6:s6") = "备注"
End With
With excelApp.ActiveSheet
.Cells(1).ColumnWidth = 9
.Cells(2).ColumnWidth = 0 '第一列
.Cells(3).ColumnWidth = 16 '第二列
.Cells(4).ColumnWidth = 12 '第三列
.Cells(5).ColumnWidth = 12 '第四列
.Cells(6).ColumnWidth = 8 '第五列
.Cells(7).ColumnWidth = 8 '第六列
.Cells(8).ColumnWidth = 12 '第七列
.Cells(9).ColumnWidth = 12 '第八列
.Cells(10).ColumnWidth = 12 '第九列
.Cells(11).ColumnWidth = 12 '第七列
.Cells(12).ColumnWidth = 12 '第八列
.Cells(13).ColumnWidth = 12 '第九列
.Cells(14).ColumnWidth = 12 '第十列
.Cells(15).ColumnWidth = 12 '第十一列
.Cells(16).ColumnWidth = 12 '第十二列
.Cells(17).ColumnWidth = 10 '第一列
.Cells(18).ColumnWidth = 12 '第十三列
.Cells(19).ColumnWidth = 12 '第十四列
End With
With excelApp.ActiveSheet
.Range("A6:s6").Borders.LineStyle = xlContinuous '表头边框线
End With
'''''''''''''''''''''''''''导出MSFLEXGRID内容'''''''''''''''''''''''''''''''''
With excelApp.ActiveSheet
For i = 1 To MSFlexGrid1.rows
For j = 0 To MSFlexGrid1.Cols
.Cells(i + 6, j + 1).Value = "" & Format$(MSFlexGrid1.TextMatrix(i, j))
Next j
.Range("a" & 7 & ":" & "s" & MSFlexGrid1.rows + 5).Borders.LineStyle = xlContinuous '设置横线(边框)
Next i
End With
With excelApp
--------------------------------另存为-----------------------------
abc = Format$(Date, "yyyymmdd") & "产成品生产与成本统计月平均报表"
aa = .Dialogs(xlDialogSaveAs).Show(abc)'
.Workbooks(1).Saved = True'不提示保存对话框
-------------------------------------------------------------------
End With
Me.MousePointer = 0'释放鼠标为读取数据
exbook.Close (True)'关闭EXBOOK
excelApp.Quit'退出
Set exsheet = Nothing'释放EXCEL
Set exbook = Nothing'释放EXCEL
Set excelApp = Nothing'释放EXCEL
MsgBox "导出成功！", vbOKOnly + vbInformation, "消息提示"
希望以上代码能为楼主解决导出.....

修改删除举报引用回复