datagrid内容输出到excel表格中？？？

[yugo_xu]

请问在ＶＢ中怎么把datagrid的内容输出到excel表格中呀？？？请详细说来，谢谢了。

[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

[of123]

方法多种：

1 如果是绑定的记录集数据，可以打开 Excel 对象，用 CopyFromRecordset 方法直接将记录集传入。

oSheet.Range("A1").CopyFromRecordset rs

2 也可以用 SQL 语句直接查询数据导出到 Excel 文件：
cnn.Execute "select * into [Sheet1] in """ & strFileName & """ ""EXCEL 5.0;"" from table"

3 如果没有绑定，也不能从数据库得到同样数据，就只有对 datagrid 和 Excel 对象逐单元格读写了。

[yugo_xu]

楼上的，如果采用第二种方法，请写的再详细点。最好带上excel的路径，以及等等东西。谢谢了。

[flyingZFX]

不过，根据楼主说的情况，应该属于最后一种，

因为，你的DataGrid中的数据肯定不是一整张表。

而且有可能还进行过修改。

所有，还是一个个的写进去最好。

[flyingZFX]

使用VBA对象吧，

引用 Excel对象

Microsoft Excel object Library 10.0 (我的是Office XP) 所以是10.0

Dim ExcelApp As Excel.Application
Dim ExcelWorkBook As Excel.WorkBook
Dim ExcelWorkSheet As Excel.WorkSheet

[yugo_xu]

我要把数据库中符合"select * from 表 where *"的记录输出到指定的excel应该怎么写呀？

[goodprogvb]

学习中...

[of123]

已经够详细了。strFileName 可以带路径，例如 "C:\My Documents\123.xls"。
cnn.Execute "select * into [Sheet1] in """ & strFileName & """ ""EXCEL 5.0;"" from table where ..."

[liyunheng]

你好!我想问下各位,要把数据输出到EXCEL里,是不是要引用EXCEL对象呢?那又究竟如何引用它?
我在工程\引用里找不到EXCEL的,电脑系统是装有的..谢了!!

[yezaoshu]

肯定是的啦,怎么找不到呀,仔细点嘛