?? grid導出到excel.txt
字號:
'數據導出到EXCEL
Public Sub ExporToExcel(strOpen As String)
On Error GoTo inter_err
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
Dim rs_date As New ADODB.Recordset
rs_date.CursorLocation = adUseClient
rs_date.Open strOpen, CONN, 3, 3
'如果沒有記錄,則不能導出
If rs_date.RecordCount < 1 Then
MsgBox ("沒有記錄!")
Exit Sub
End If
Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlsheet = Nothing
Set xlBook = xlApp.Workbooks().add
Set xlsheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
'添加查詢語句,導入EXCEL數據
Set xlQuery = xlsheet.QueryTables.add(rs_date, xlsheet.Range("a1"))
xlQuery.refresh
'列名用數據窗體列頭中文顯示
For j = 0 To grid_export.Cols - 1
xlsheet.Cells(1, j + 1) = grid_export.TextMatrix(0, j)
Next
'***********************************
xlApp.Application.Visible = True
rs_date.Close
Set xlApp = Nothing '"交還控制給Excel
Set xlBook = Nothing
Set xlsheet = Nothing
Exit Sub
inter_err:
Call sub_error
End Sub
Private Sub 導出_Click()
Set grid_export = 生產電腦在庫查詢.Grid1 '設置導出哪個數據窗體的數據
Call ExporToExcel(select_string) '導出的數據為當前顯示的所有SQL數據
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -