vb数据库导出excel
① 怎样在VB中导出一个电子表格（excel)
一个按钮，五个文本框（文本框用复制方式）
dim
xlsapp
as
excel.application
dim
xlsbook
as
excel.workbook
dim
xlssheet
as
excel.worksheet
set
xlsapp
=
new
excel.application
set
xlsbook
=
xlsapp.workbooks.add
set
xlssheet
=
xlsbook.worksheets(1)
xlssheet.application.columns("a:l").numberformatlocal
=
"@"
'文本格式为通用
xlssheet.cells.horizontalalignment
=
xlcenter
'文本居中
xlssheet.columns("a:l").columnwidth
=
5
'调整列宽（从a列到l列
dim
i
as
integer
for
i
=
0
to
4
xlssheet.cells(
2,
i+
1)
=
text1(i).text
next
i
xlsapp.visible
=
true
set
xlsapp
=
nothing
自己可以研究一下上面的代码（其中文本框用复制做数组）
② vb导出excel
VB是常用的应用软件开发工具之一，由于VB的报表功能有限，而且一但报表格式发生变化，就得相应修改程序，给应用软件的维护工作带来极大的不便。因此有很多程序员现在已经充分利用EXECL的强大报表功来实现报表功能。但由于VB与EXCEL由于分别属于不同的应用系统，如何把它们有机地结合在一起，是一个值得我们研究的课题。
一、 VB读写EXCEL表：
VB本身提自动化功能可以读写EXCEL表，其方法如下：
1、在工程中引用Microsoft Excel类型库：
从"工程"菜单中选择"引用"栏；选择Microsoft Excel 9.0 Object Library（EXCEL2000），然后选择"确定"。表示在工程中要引用EXCEL类型库。
2、在通用对象的声明过程中定义EXCEL对象：
Dim xlApp As Excel.Application
Dim xlBook As Excel.WorkBook
Dim xlSheet As Excel.Worksheet
3、在程序中操作EXCEL表常用命令：
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open("文件名") '打开已经存在的EXCEL工件簿文件
xlApp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("表名") '设置活动工作表
xlSheet.Cells(row, col) =值 '给单元格（row,col）赋值
xlSheet.PrintOut '打印工作表
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
xlBook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏
4、在运用以上VB命令操作EXCEL表时，除非设置EXCEL对象不可见，否则VB程序可继续执行其它操作，也能够关闭EXCEL，同时也可对EXCEL进行操作。但在EXCEL操作过程中关闭EXCEL对象时，VB程序无法知道，如果此时使用EXCEL对象，则VB程序会产生自动化错误。形成VB程序无法完全控制EXCEL的状况，使得VB与EXCEL脱节。
二、 EXCEL的宏功能：
EXCEL提供一个Visual Basic编辑器，打开Visual Basic编辑器，其中有一工程属性窗口，点击右键菜单的"插入模块"，则增加一个"模块1"，在此模块中可以运用Visual Basic语言编写函数和过程并称之为宏。其中，EXCEL有两个自动宏：一个是启动宏（Sub Auto_Open()），另一个是关闭宏（Sub Auto_Close()）。它们的特性是：当用EXCEL打含有启动宏的工簿时，就会自动运行启动宏，同理，当关闭含有关闭宏的工作簿时就会自动运行关闭宏。但是通过VB的自动化功能来调用EXCEL工作表时，启动宏和关闭宏不会自动运行，而需要在VB中通过命令xlBook.RunAutoMacros (xlAutoOpen)和xlBook.RunAutoMacros (xlAutoClose) 来运行启动宏和关闭宏。
三、 VB与EXCEL的相互勾通：
充分利用EXCEL的启动宏和关闭宏，可以实现VB与EXCEL的相互勾通，其方法如下：
在EXCEL的启动宏中加入一段程序，其功能是在磁盘中写入一个标志文件，同时在关闭宏中加入一段删除此标志文件的程序。VB程序在执行时通过判断此标志文件存在与否来判断EXCEL是否打开，如果此标志文件存在，表明EXCEL对象正在运行，应该禁止其它程序的运行。如果此标志文件不存在，表明EXCEL对象已被用户关闭，此时如果要使用EXCEL对象运行，必须重新创建EXCEL对象。
四、举例：
1、在VB中，建立一个FORM，在其上放置两个命令按钮，将Command1的Caption属性改为EXCEL，Command2的Caption属性改为End。然后在其中输入如下程序：
Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
Private Sub Command1_Click() '打开EXCEL过程
If Dir("D:\temp\excel.bz") = "" Then '判断EXCEL是否打开
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = True '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open("D:\temp\bb.xls") '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate '激活工作表
xlsheet.Cells(1, 1) = "abc" '给单元格1行驶列赋值
xlBook.RunAutoMacros (xlAutoOpen) 运行EXCEL中的启动宏
Else
MsgBox ("EXCEL已打开")
End If
End Sub
Private Sub Command2_Click()
If Dir("D:\temp\excel.bz") <> "" Then '由VB关闭EXCEL
xlBook.RunAutoMacros (xlAutoClose) '执行EXCEL关闭宏
xlBook.Close (True) '关闭EXCEL工作簿
xlApp.Quit '关闭EXCEL
End If
Set xlApp = Nothing '释放EXCEL对象
End
End Sub
2、在D盘根目录上建立一个名为Temp的子目录，在Temp目录下建立一个名为"bb.xls"的EXCEL文件。
3、在"bb.xls"中打开Visual Basic编辑器，在工程窗口中点鼠标键选择插入模块，在模块中输入入下程序存盘：
Sub auto_open()
Open "d:\temp\excel.bz" For Output As #1 '写标志文件
Close #1
End Sub
Sub auto_close()
Kill "d:\temp\excel.bz" '删除标志文件
End Sub
4、运行VB程序，点击EXCEL按钮可以打开EXCEL系统，打开EXCEL系统后，VB程序和EXCEL分别属两个不同的应用系统，均可同时进行操作，由于系统加了判断，因此在VB程序中重复点击EXCEL按钮时会提示EXCEL已打开。如果在EXCEL中关闭EXCEL后再点EXCEL按钮，则会重新打开EXCEL。而无论EXCEL打开与否，通过VB程序均可关闭EXCEL。这样就实现了VB与EXCEL的无缝连接。
③ VB数据导出EXCEL
去掉这几句
mExcelFile.SaveAs "c:\123.xls"
mExcelFile.Application.Quit
Set mExcelFile = Nothing
他们的意思是保存，然后关闭。
在同位置写入
mExcelFile.visible=true
这句意思是显示excel文件窗口
④ VB导出EXCEL数据格式问题
其他都正常，在excel数据类型为数值时，for循环内加上，if条件数值类型保留两位小数即可
用下面这段代码，根据自己实际修改一下就好
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
⑥ 如何用vb把数据库中的数据，写到 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 = "查询数据" '加标头；
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 从SQL数据库中把数据导出到Excel表格中，怎么写
SubdataToExcel()
DimconnAsString
DimrsAsNewADODB.Recordset
DimexcelAsObject
DimworkbookAsObject
DimsheetAsObject
Dimi&,j&
'SQL数据库的连接字串
conn="Provider=SQLOLEDB.1;Datasource=服务器地址;initialcatalog=数据库名称;UserId=数据库登录账号;Password=数据库登录账号"
'打开到sql的连接，读取xxx表数据到rs
rs.Open"select*fromxxx",conn,adOpenKeyset,adLockReadOnly
'excel对象、工作簿、工作表
Setexcel=CreateObject("Excel.Application")
Setworkbook=excel.workbooks().Add()
Setsheet=workbook.sheets(1)
excel.Visible=True
'循环读取rs并写入到excel
Fori=1Tors.Fields.Count
j=1
rs.MoveFirst
DoWhileNotrs.EOF
sheet.cells(j,i)=rs.Fields(i-1).Value
rs.MoveNext
j=j+1
Loop
Next
rs.Close
Setrs=Nothing
EndSub
⑧ vb导出到excel
Option Explicit
Private Sub Form_Load()
Dim i As Long, j As Long
Me.MSHFlexGrid1.Rows = 2000
Me.MSHFlexGrid1.Cols = 10
For i = 0 To Me.MSHFlexGrid1.Rows - 1
For j = 0 To Me.MSHFlexGrid1.Cols - 1
Me.MSHFlexGrid1.TextMatrix(i, j) = i & "行" & j & "列"
Next
Next
Debug.Print Me.MSHFlexGrid1.TextArray(100)
End Sub
Private Sub cmdExport_Click()
Dim i As Long, j As Long
Dim CellsData() As String
Dim objApp As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
'构造二维数组
ReDim CellsData(1 To Me.MSHFlexGrid1.Rows, 1 To Me.MSHFlexGrid1.Cols)
For i = 1 To Me.MSHFlexGrid1.Rows
For j = 1 To Me.MSHFlexGrid1.Cols
CellsData(i, j) = Me.MSHFlexGrid1.TextMatrix(i - 1, j - 1)
Next
Next
'导出到Excel中
Set objApp = New Excel.Application
objApp.ScreenUpdating = False '禁止屏幕刷新
Set objWorkbook = objApp.Workbooks.Add
Set objWorksheet = objWorkbook.Sheets.Add
Set objRange = objWorksheet.Range(objWorksheet.Cells(1, 1), objWorksheet.Cells(Me.MSHFlexGrid1.Rows, Me.MSHFlexGrid1.Cols))
objRange.Value = CellsData
objApp.Visible = True
objApp.ScreenUpdating = True
'销毁二维数组
Erase CellsData
Me.SetFocus
MsgBox "导出完毕"
End Sub