VB中把SQL数据库的数据输出到Excel
在VB里实现先在窗体里用GRIDDATA控件来显示数据库的数据,然后把这些数据导入到Excel里,并保存。最好有按钮控件。求实现这样的功能的代码,小弟万分感激。。。请大侠...
在VB里实现先在窗体里用GRIDDATA控件来显示数据库的数据,然后把这些数据导入到Excel里,并保存。最好有按钮控件。求实现这样的功能的代码,小弟万分感激。。。请大侠们帮帮我,分会再加的!
展开
3个回答
展开全部
用下面这段代码,根据自己实际修改一下就好
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
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
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
一下是一个Listview控件导出数据到Excel,你可以把Listview控件改成GRIDDATA。
Dim ex As Object
Dim bk As Object
Dim sh As Object
Sub 导出Excel数据()
On Error Resume Next
Form8.CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
Form8.CommonDialog1.ShowSave
Dim GetFileName As Variant
GetFileName = Form8.CommonDialog1.FileName
If Trim(GetFileName) = "" Then Exit Sub
Set ex = CreateObject("Excel.Application")
Set bk = ex.Workbooks.Add
Set sh = bk.worksheets(1)
ex.Workbooks(1).SaveAs GetFileName
If Form8.标题 = "PAL ZILERI 发货明细表" Then
sh.cells(1, 1) = "店铺名称"
sh.cells(1, 2) = "发货日期"
sh.cells(1, 3) = "产品编号"
sh.cells(1, 4) = "类别"
sh.cells(1, 5) = "颜色"
sh.cells(1, 6) = "号型"
sh.cells(1, 7) = "发货数量"
sh.cells(1, 8) = "发货单号"
sh.cells(1, 9) = "备注"
row = 2
For x = 1 To Form8.ListView1.ListItems.Count
sh.cells(row, 1) = Form8.ListView1.ListItems(x).Text '店铺名称
sh.cells(row, 2) = Form8.ListView1.ListItems(x).ListSubItems(1) '发货日期
sh.cells(row, 3) = Form8.ListView1.ListItems(x).ListSubItems(2) '产品编号
sh.cells(row, 4) = Form8.ListView1.ListItems(x).ListSubItems(3) '类别
sh.cells(row, 5) = Form8.ListView1.ListItems(x).ListSubItems(4) '颜色
sh.cells(row, 6) = Form8.ListView1.ListItems(x).ListSubItems(5) '号型
sh.cells(row, 7) = Val(Form8.ListView1.ListItems(x).ListSubItems(6)) '发货数量
sh.cells(row, 8) = Form8.ListView1.ListItems(x).ListSubItems(7) '发货单号
sh.cells(row, 9) = Form8.ListView1.ListItems(x).ListSubItems(8) '备注
row = row + 1
Next x
ex.Workbooks(1).Close True
ex.Quit
Set ex = Nothing
Set sh = Nothing
MsgBox "数据导出成功", vbInformation, "导出数据"
End Sub
Dim ex As Object
Dim bk As Object
Dim sh As Object
Sub 导出Excel数据()
On Error Resume Next
Form8.CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
Form8.CommonDialog1.ShowSave
Dim GetFileName As Variant
GetFileName = Form8.CommonDialog1.FileName
If Trim(GetFileName) = "" Then Exit Sub
Set ex = CreateObject("Excel.Application")
Set bk = ex.Workbooks.Add
Set sh = bk.worksheets(1)
ex.Workbooks(1).SaveAs GetFileName
If Form8.标题 = "PAL ZILERI 发货明细表" Then
sh.cells(1, 1) = "店铺名称"
sh.cells(1, 2) = "发货日期"
sh.cells(1, 3) = "产品编号"
sh.cells(1, 4) = "类别"
sh.cells(1, 5) = "颜色"
sh.cells(1, 6) = "号型"
sh.cells(1, 7) = "发货数量"
sh.cells(1, 8) = "发货单号"
sh.cells(1, 9) = "备注"
row = 2
For x = 1 To Form8.ListView1.ListItems.Count
sh.cells(row, 1) = Form8.ListView1.ListItems(x).Text '店铺名称
sh.cells(row, 2) = Form8.ListView1.ListItems(x).ListSubItems(1) '发货日期
sh.cells(row, 3) = Form8.ListView1.ListItems(x).ListSubItems(2) '产品编号
sh.cells(row, 4) = Form8.ListView1.ListItems(x).ListSubItems(3) '类别
sh.cells(row, 5) = Form8.ListView1.ListItems(x).ListSubItems(4) '颜色
sh.cells(row, 6) = Form8.ListView1.ListItems(x).ListSubItems(5) '号型
sh.cells(row, 7) = Val(Form8.ListView1.ListItems(x).ListSubItems(6)) '发货数量
sh.cells(row, 8) = Form8.ListView1.ListItems(x).ListSubItems(7) '发货单号
sh.cells(row, 9) = Form8.ListView1.ListItems(x).ListSubItems(8) '备注
row = row + 1
Next x
ex.Workbooks(1).Close True
ex.Quit
Set ex = Nothing
Set sh = Nothing
MsgBox "数据导出成功", vbInformation, "导出数据"
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |