DATAGRID“显示”的数据导出到EXCEL

[goodluck2005]

怎么样能将DATAGRID“显示”（不是全部）的数据导出到EXCEL
希望给出带控件的源代码，注释越多越好啊
ADO+ACCESS

[goodluck2005]

是我没说明白还是问题难啊？
其实是把
Adodc1.RecordSource = "select ＊from 表 where 成绩＝90"
Adodc1.Refresh
的记录输出到EXCEL

[Andy__Huang]

你只要把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

[goodluck2005]

谢谢帮助，我是添加ADO控件进行筛选的，
你的是代码连接的啊？能帮我改一下吗？

[goodluck2005]

还有一个问题，我有很多筛选条件，你那段语句怎么确我最执行的是哪句筛选语句哪？？？
我比较菜，希望没有吓到你

[yangzhixue]

关注

[daisy8675]

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

[goodluck2005]

我是添加ADO控件的，以类似的代码，或有窗体的源代码吗？感谢感谢

[faib920]

参照这个 Conn.Execute "SELECT * INTO [Excel 8.0;DATABASE=Excel文件.[WorkSheet1] FROM 表"

[goodluck2005]

能说的再具体些吗？

[goodluck2005]

莫依美女，谢谢你的帮助，你给我的是个模块吧？？？
具体怎么用啊，谢谢

[of123]

execel 是 jet engine 所支持的外部数据库之一，直接导出即可：

Adodc1.RecordSet.ActiveConnection.Execute "select * into [sheet1] in ""c:\my documents\test.xls"" ""Excel 5.0;"" from 表 where 成绩 = 90"

[goodluck2005]

of123() 谢谢你的帮助
我想输出的是我经过随机筛选后的数据，并不是整个库的数据啊？能否帮助改进一下？

[moren]

of123 伙计你的代码怎么调试不过

[zzzjaychung]

哥哥，，，你把你想做的讲清楚一些，让别人帮你写就好了，你就不用写了，
上面的星星都讲的很仔细了啊。。。。。。
拜托自己也想一想啊。
星星们都不好意思说，我不是星星，我来说。。。。

我会尽我可能帮助有问题的人，便我愿意帮助只要代码不动脑的人。。。。。

[goodluck2005]

zzzjaychung(追逐幸福的风筝)
说的有道理啊！！！遇事是不能什么都靠别人的，得自己努力。

[zzzjaychung]

哈哈哈，
这里不错，很多好人，高人回答问题。
一起油吧。

[goodluck2005]

我还有个问题？用EXCEL录制的宏怎么用啊？还需要定义什么变量吗？