863
社区成员
5.5w+
社区内容
- 主页
DATAGRID“显示”的数据导出到EXCEL
怎么样能将DATAGRID“显示”（不是全部）的数据导出到EXCEL
希望给出带控件的源代码，注释越多越好啊
ADO+ACCESS
希望给出带控件的源代码，注释越多越好啊
ADO+ACCESS
...全文
goodluck2005 2005年03月24日
我还有个问题？用EXCEL录制的宏怎么用啊？还需要定义什么变量吗？
zzzjaychung 2005年03月23日
哈哈哈，
这里不错，很多好人，高人回答问题。
一起油吧。
这里不错，很多好人，高人回答问题。
一起油吧。
goodluck2005 2005年03月22日
zzzjaychung(追逐幸福的风筝)
说的有道理啊！！！遇事是不能什么都靠别人的，得自己努力。
说的有道理啊！！！遇事是不能什么都靠别人的，得自己努力。
zzzjaychung 2005年03月22日
哥哥，，，你把你想做的讲清楚一些，让别人帮你写就好了，你就不用写了，
上面的星星都讲的很仔细了啊。。。。。。
拜托自己也想一想啊。
星星们都不好意思说，我不是星星，我来说。。。。
我会尽我可能帮助有问题的人，便我愿意帮助只要代码不动脑的人。。。。。
上面的星星都讲的很仔细了啊。。。。。。
拜托自己也想一想啊。
星星们都不好意思说，我不是星星，我来说。。。。
我会尽我可能帮助有问题的人，便我愿意帮助只要代码不动脑的人。。。。。
moren 2005年03月22日
of123 伙计你的代码怎么调试不过
goodluck2005 2005年03月20日
of123() 谢谢你的帮助
我想输出的是我经过随机筛选后的数据，并不是整个库的数据啊？能否帮助改进一下？
我想输出的是我经过随机筛选后的数据，并不是整个库的数据啊？能否帮助改进一下？
of123 2005年03月20日
execel 是 jet engine 所支持的外部数据库之一，直接导出即可：
Adodc1.RecordSet.ActiveConnection.Execute "select * into [sheet1] in ""c:\my documents\test.xls"" ""Excel 5.0;"" from 表 where 成绩 = 90"
Adodc1.RecordSet.ActiveConnection.Execute "select * into [sheet1] in ""c:\my documents\test.xls"" ""Excel 5.0;"" from 表 where 成绩 = 90"
goodluck2005 2005年03月20日
莫依美女，谢谢你的帮助，你给我的是个模块吧？？？
具体怎么用啊，谢谢
具体怎么用啊，谢谢
goodluck2005 2005年03月20日
能说的再具体些吗？
faib920 2005年03月20日
参照这个 Conn.Execute "SELECT * INTO [Excel 8.0;DATABASE=Excel文件.[WorkSheet1] FROM 表"
goodluck2005 2005年03月19日
我是添加ADO控件的，以类似的代码，或有窗体的源代码吗？感谢感谢
daisy8675 2005年03月19日
DataGrid 不同于 MSFlexGrid 部份，在于后者是一次读取数据全部放置表格，而 DataGrid 则是需要显示数据时，才向 ADODB.Recordset 对象或 ADODC 读取必要的数据。因此汇出 DataGrid 数据时的来源要指向 ADODB.Recordset 对象或 ADODC，而不是针对 DataGrid 显示本身。而 MSFlexgird 因为表格已含有全部数据，当然可以逐笔读取表格内容。
Sub SaveAsExcel(ByVal objRst As ADODB.Recordset, _
ByVal strFileName As String, _
Optional FileFormat As XlFileFormat = xlWorkbookNormal, _
Optional blnHeaders As Boolean = True)
Dim intRowCnt As Integer ' 列之计数器。
Dim intColCnt As Integer ' 栏之计数器。
Dim objExcel As Excel.Application
Dim objFld As Field
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim strFileExtensionType As String ' 延伸檔名。
On Error GoTo SaveAsExcel_EH
Screen.MousePointer = vbHourglass
'------------------------------------------------
' A0 Excel 相关设定作业。
'------------------------------------------------
Set objExcel = New Excel.Application
' 不让使用者操作。
objExcel.Interactive = False
' 背后作业。
If objExcel.Visible = False Then
objExcel.Visible = True
End If
' 窗口最大化。
objExcel.WindowState = xlMaximized
' 设定 Wokkbook 对象。
Set objWorkbook = objExcel.Workbooks.Add
' 设定 Worksheet 对象，指向 Sheet 1。
Set objWorksheet = objWorkbook.Worksheets.Add
'------------------------------------------------
' A1 Excel 表头部份相关设定作业。
'------------------------------------------------
If blnHeaders Then
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
' 下述数据型态则予以略过。
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Cells(1, intColCnt).Value = objFld.Name
objWorksheet.Cells(1, intColCnt).Interior.ColorIndex = 33
objWorksheet.Cells(1, intColCnt).Font.Bold = True
objWorksheet.Cells(1, intColCnt).BorderAround xlContinuous
intColCnt = intColCnt + 1
End Select
Next objFld
End If
'------------------------------------------------
' A2 Excel 表身部份相关设定作业。
'------------------------------------------------
objRst.MoveFirst
intRowCnt = 2
Do While Not objRst.EOF()
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Cells(intRowCnt, intColCnt).Value = objRst.Fields(objFld.Name).Value
intColCnt = intColCnt + 1
End Select
Next objFld
objRst.MoveNext
intRowCnt = intRowCnt + 1
Loop
'------------------------------------------------
' A3 Excel 自动调整栏宽。
'------------------------------------------------
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Columns(intColCnt).AutoFit
intColCnt = intColCnt + 1
End Select
Next objFld
'------------------------------------------------
' B1 取得延伸檔名。
' 参阅 Excel 说明里的「Microsoft Excel 提供的档案格式转换器」
'------------------------------------------------
Select Case FileFormat
Case xlSYLK
strFileExtensionType = "slk"
Case xlWKS
strFileExtensionType = "wks"
Case xlWK1, xlWK1ALL, xlWK1FMT
strFileExtensionType = "wk1"
Case xlCSV, xlCSVMac, xlCSVWindows
strFileExtensionType = "csv"
Case xlDBF2, xlDBF3, xlDBF4
strFileExtensionType = "dbf"
Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7, xlExcel9795
strFileExtensionType = "xls"
Case xlHtml
strFileExtensionType = "htm"
Case xlTextMac, xlTextWindows, xlUnicodeText, xlCurrentPlatformText
strFileExtensionType = "txt"
Case xlTextPrinter
strFileExtensionType = "prn"
Case Else
strFileExtensionType = "dat"
End Select
'------------------------------------------------
' B2 另存档案。
'------------------------------------------------
If InStr(1, strFileName, ".") = 0 Then
' 组合文件名称。
strFileName = strFileName & "." & strFileExtensionType
' 另存档案。
objWorksheet.SaveAs strFileName, FileFormat
End If
'------------------------------------------------
' Z0 结束作业。
'------------------------------------------------
' 关闭 Workbook。
objWorkbook.Close
' 结束 Excel 作业。
objExcel.Quit
' 释放对象所占空间。
Set objFld = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
ExitSub:
Screen.MousePointer = vbDefault
Exit Sub
SaveAsExcel_EH:
' 出现错误讯息。
MsgBox "汇出失败，原因如下：" & vbCrLf & vbCrLf & Err.Number & ": " & Err.Description, _
vbOKOnly + vbCritical, "汇出失败"
' 关闭 Workbook。
objWorkbook.Close
' 结束 Excel 作业。
objExcel.Quit
' 载出对象变量。
Set objFld = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
GoTo ExitSub
End Sub
Sub SaveAsExcel(ByVal objRst As ADODB.Recordset, _
ByVal strFileName As String, _
Optional FileFormat As XlFileFormat = xlWorkbookNormal, _
Optional blnHeaders As Boolean = True)
Dim intRowCnt As Integer ' 列之计数器。
Dim intColCnt As Integer ' 栏之计数器。
Dim objExcel As Excel.Application
Dim objFld As Field
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim strFileExtensionType As String ' 延伸檔名。
On Error GoTo SaveAsExcel_EH
Screen.MousePointer = vbHourglass
'------------------------------------------------
' A0 Excel 相关设定作业。
'------------------------------------------------
Set objExcel = New Excel.Application
' 不让使用者操作。
objExcel.Interactive = False
' 背后作业。
If objExcel.Visible = False Then
objExcel.Visible = True
End If
' 窗口最大化。
objExcel.WindowState = xlMaximized
' 设定 Wokkbook 对象。
Set objWorkbook = objExcel.Workbooks.Add
' 设定 Worksheet 对象，指向 Sheet 1。
Set objWorksheet = objWorkbook.Worksheets.Add
'------------------------------------------------
' A1 Excel 表头部份相关设定作业。
'------------------------------------------------
If blnHeaders Then
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
' 下述数据型态则予以略过。
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Cells(1, intColCnt).Value = objFld.Name
objWorksheet.Cells(1, intColCnt).Interior.ColorIndex = 33
objWorksheet.Cells(1, intColCnt).Font.Bold = True
objWorksheet.Cells(1, intColCnt).BorderAround xlContinuous
intColCnt = intColCnt + 1
End Select
Next objFld
End If
'------------------------------------------------
' A2 Excel 表身部份相关设定作业。
'------------------------------------------------
objRst.MoveFirst
intRowCnt = 2
Do While Not objRst.EOF()
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Cells(intRowCnt, intColCnt).Value = objRst.Fields(objFld.Name).Value
intColCnt = intColCnt + 1
End Select
Next objFld
objRst.MoveNext
intRowCnt = intRowCnt + 1
Loop
'------------------------------------------------
' A3 Excel 自动调整栏宽。
'------------------------------------------------
intColCnt = 1
For Each objFld In objRst.Fields
Select Case objFld.Type
Case adGUID, adLongVarBinary, adLongVarWChar
Case Else
objWorksheet.Columns(intColCnt).AutoFit
intColCnt = intColCnt + 1
End Select
Next objFld
'------------------------------------------------
' B1 取得延伸檔名。
' 参阅 Excel 说明里的「Microsoft Excel 提供的档案格式转换器」
'------------------------------------------------
Select Case FileFormat
Case xlSYLK
strFileExtensionType = "slk"
Case xlWKS
strFileExtensionType = "wks"
Case xlWK1, xlWK1ALL, xlWK1FMT
strFileExtensionType = "wk1"
Case xlCSV, xlCSVMac, xlCSVWindows
strFileExtensionType = "csv"
Case xlDBF2, xlDBF3, xlDBF4
strFileExtensionType = "dbf"
Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7, xlExcel9795
strFileExtensionType = "xls"
Case xlHtml
strFileExtensionType = "htm"
Case xlTextMac, xlTextWindows, xlUnicodeText, xlCurrentPlatformText
strFileExtensionType = "txt"
Case xlTextPrinter
strFileExtensionType = "prn"
Case Else
strFileExtensionType = "dat"
End Select
'------------------------------------------------
' B2 另存档案。
'------------------------------------------------
If InStr(1, strFileName, ".") = 0 Then
' 组合文件名称。
strFileName = strFileName & "." & strFileExtensionType
' 另存档案。
objWorksheet.SaveAs strFileName, FileFormat
End If
'------------------------------------------------
' Z0 结束作业。
'------------------------------------------------
' 关闭 Workbook。
objWorkbook.Close
' 结束 Excel 作业。
objExcel.Quit
' 释放对象所占空间。
Set objFld = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
ExitSub:
Screen.MousePointer = vbDefault
Exit Sub
SaveAsExcel_EH:
' 出现错误讯息。
MsgBox "汇出失败，原因如下：" & vbCrLf & vbCrLf & Err.Number & ": " & Err.Description, _
vbOKOnly + vbCritical, "汇出失败"
' 关闭 Workbook。
objWorkbook.Close
' 结束 Excel 作业。
objExcel.Quit
' 载出对象变量。
Set objFld = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
GoTo ExitSub
End Sub
yangzhixue 2005年03月19日
关注
goodluck2005 2005年03月19日
还有一个问题，我有很多筛选条件，你那段语句怎么确我最执行的是哪句筛选语句哪？？？
我比较菜，希望没有吓到你
我比较菜，希望没有吓到你
goodluck2005 2005年03月19日
谢谢帮助，我是添加ADO控件进行筛选的，
你的是代码连接的啊？能帮我改一下吗？
你的是代码连接的啊？能帮我改一下吗？
Andy__Huang 2005年03月19日
你只要把datagrid的數據源與Excel的數據源設置成一樣，就可以了
Private Sub Command3_Click()
Dim objFileSystem As Object
Dim objExcelText As Object
Dim strTableString As String, i As Integer, strFileName As String
Dim pubConn As New ADODB.Connection
Dim rsTable As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String
strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerNmae"
pubConn.Open strConn
rsTable.CursorLocation = adUseClient
strSQL = "select top 10 * from gate_register"
rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic
For i = 0 To rsTable.Fields.Count - 1
strTableString = strTableString & rsTable.Fields(i).Name & Chr(9) '獲取字段名
Next
strTableString = strTableString & rsTable.GetString '字段名+數據庫的記錄
cmDialog.CancelError = False
cmDialog.FileName = "FileName" '默認生成的文件名
cmDialog.DialogTitle = "Save Export File"
cmDialog.Filter = "Excel (*.xls)|*.xls|文本文件(*.DBF)|*.DBF|檔案文件(*.doc)|*.doc|所有文件(*.*)|*.*"
cmDialog.DefaultExt = "*.xls"
cmDialog.ShowSave
strFileName = cmDialog.FileName
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objExcelText = objFileSystem.createtextfile(strFileName, True)
objExcelText.writeline (strTableString)
objExcelText.Close
Set objFileSystem = Nothing
End Sub
Private Sub Command3_Click()
Dim objFileSystem As Object
Dim objExcelText As Object
Dim strTableString As String, i As Integer, strFileName As String
Dim pubConn As New ADODB.Connection
Dim rsTable As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String
strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerNmae"
pubConn.Open strConn
rsTable.CursorLocation = adUseClient
strSQL = "select top 10 * from gate_register"
rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic
For i = 0 To rsTable.Fields.Count - 1
strTableString = strTableString & rsTable.Fields(i).Name & Chr(9) '獲取字段名
Next
strTableString = strTableString & rsTable.GetString '字段名+數據庫的記錄
cmDialog.CancelError = False
cmDialog.FileName = "FileName" '默認生成的文件名
cmDialog.DialogTitle = "Save Export File"
cmDialog.Filter = "Excel (*.xls)|*.xls|文本文件(*.DBF)|*.DBF|檔案文件(*.doc)|*.doc|所有文件(*.*)|*.*"
cmDialog.DefaultExt = "*.xls"
cmDialog.ShowSave
strFileName = cmDialog.FileName
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objExcelText = objFileSystem.createtextfile(strFileName, True)
objExcelText.writeline (strTableString)
objExcelText.Close
Set objFileSystem = Nothing
End Sub
goodluck2005 2005年03月19日
是我没说明白还是问题难啊？
其实是把
Adodc1.RecordSource = "select ＊from 表 where 成绩＝90"
Adodc1.Refresh
的记录输出到EXCEL
其实是把
Adodc1.RecordSource = "select ＊from 表 where 成绩＝90"
Adodc1.Refresh
的记录输出到EXCEL