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