Question

vb能不能把DataGrid中查询到的结果导出到Excel文件中呢?

我用的一个按扭(ACD1)做查询,查询后在DataGrid1中显示出来,怎样才能把内容导出到Excel文件中呢? Private Sub ACD1_Click() sqlstr = "SELECT 名称,规格,附图 from 内容表 where 编号='" & DTXT.Text & "'" DataEnvironment1.Commands("FINDBJNR").CommandText = sqlstr DataEnvironment1.HQ.Close DataEnvironment1.HQ.Open DataEnvironment1.FINDBJNR DataGrid1.ClearFields DataGrid1.DataMember = DataEnvironment1.Commands("FINDBJNR").Name DataGrid1.ReBind End Sub ACCESS数据库是用下面方式连接的: Private Sub DataEnvironment_Initialize() DataEnvironmen1.HQ.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\XTAHQ.mdb;Mode=Read|Write|Share Deny None;Persist Security Info=False" End Sub

Answer 1

举个例子:
Private
Sub
ACD1_Click()
Dim
i,
k
As
Integer,
r
As
Integer,
c
As
Integer
Dim
newxls
As
New
Excel.Application
Dim
newbook
As
New
Excel.Workbook
Dim
newsheet
As
New
Excel.Worksheet
Set
newbook
=
newxls.Workbooks.Add
'创建工作簿
Set
newsheet
=
newbook.Worksheets(1)
'创建工作表
If
Adodc1.Recordset.RecordCount
>
0
Then
newsheet.Columns("A:A").ColumnWidth
=
4
newsheet.Columns("B:B").ColumnWidth
=
8
newsheet.Columns("C:C").ColumnWidth
=
16
newsheet.Columns("D:D").ColumnWidth
=
24
newsheet.Columns("E:E").ColumnWidth
=
4
newsheet.Columns("F:F").ColumnWidth
=
8
newsheet.Columns("G:G").ColumnWidth
=
4
newsheet.Columns("H:H").ColumnWidth
=
8
'指定表格内容
Adodc1.Recordset.MoveFirst
k
=
1
Do
Until
Adodc1.Recordset.EOF
r
=
Adodc1.Recordset.AbsolutePosition
For
c
=
1
To
DataGrid1.Columns.Count
-
1
newsheet.Cells(r
+
3,
c
+
1).Font.Size
=
11
newsheet.Cells(r
+
3,
1)
=
k
newsheet.Cells(r
+
3,
5)
=
Trim(DataGrid1.Columns(4))
newsheet.Cells(r
+
3,
6)
=
Space(8
-
Len(DataGrid1.Columns(5)))
&
Format(DataGrid1.Columns(5).Text,
"0.000")
DataGrid1.Col
=
c
newsheet.Cells(r
+
3,
c
+
1)
=
DataGrid1.Columns(c)
Next
c
Adodc1.Recordset.MoveNext
k
=
k
+
1
Loop
Dim
aa
aa
=
MsgBox("是否保存该Excel表?",
vbYesNo,
"提示窗口")
If
aa
=
vbYes
Then
CommonDialog1.ShowSave
On
Error
GoTo
ErrSave
newsheet.SaveAs
CommonDialog1.FileName
'
MsgBox
"保存成功"
newxls.Quit
ErrSave:
Exit
Sub
MsgBox
Err.Description,
,
"提示窗口"
End
If
End
If
End
Sub