vb中的datagrid里面的数据如何导出到excel表里面

Posted 2023-05-07

请写详细点，谢谢各位大神！！！我在线等！！分数不够我还可以追加，急啊！！
Dim a, b As String
Dim txtsql As String
Private Sub Command1_Click()
b = Option2.Value
Dim rs0 As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
b = True
txtsql = "select 队名,地类, sum(面积数) as 总数 from 包厢 group by 队名,地类"
rs0.CursorLocation = adUseClient
rs0.Open txtsql, cn, adOpenKeyset, adLockPessimistic
Set DataGrid1.DataSource = rs0
rs0.Requery
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
这是我界面确定按钮的代码，当我点确定的时候，统计数据显示在datagrid里面
我的意思是想点command3的时候统计数据就导出到excel表中去，该怎么弄啊！！
请各位大神帮忙！！

这个其实很简单的，步骤如下：
首先在你的工程中引用Excel对象，比如“Microsoft Excel 11 Object Library”；
然后在执行导出的代码里声明对象（代码仅供参考）:
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strFilename as String ''Excel文件
Dim i as Integer,j as Integer

Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = False '设置EXCEL不可见
Set xlBook = xlApp.Workbooks.Open(strFilename) '打开EXCEL工作簿
Set xlSheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlSheet.Activate '激活工作表
xlBook.RunAutoMacros (xlAutoOpen) ''运行EXCEL中的启动宏

''写入数据到Excel
For i=1 to 100
For j=1 to 100
xlSheet.Cells(i, j) = "i=" & cstr(i) & ";j=" & cstr(j)
Next
Next
'大功告成，关闭对象以及退出
xlBook.Save ‘''保存关闭文档
xlBook.RunAutoMacros (xlAutoClose) '关闭宏
xlBook.Close (True) '关闭EXCEL工作簿
xlApp.Quit '关闭EXCEL 参考技术A 先保存到DataSet中，然后再保存到Excel中追问

能具体点吗，大神，如何操作，能麻烦你给点代码吗！！！

参考技术B 如果想把datagrid里的数据打印出来怎么实现
方法太多了，可以直接打印窗体，可以用水晶报表，可以调用printer，但如果你把它导出到Excel，比上面的方案都好。

导出到EXCEL要用到excel程序提供的Application对像
使用前先在 工程 －－引用 里添加Microsoft excel.....的引用。
然后定义 application...
还是给你看一段代码吧。希望对你有帮助

控件 adodc+datagrid+command
Private Sub cmdExport_Click()
Dim i As Integer, r As Integer, c As Integer
Dim newxls As Excel.Application
Dim newbook As Excel.Workbook
Dim newsheet As Excel.Worksheet
Set newxls = CreateObject("Excel.Application") '创建excel应用程序,打开excel2000
Set newbook = newxls.Workbooks.Add '创建工作簿
Set newsheet = newbook.Worksheets(1) '创建工作表
If sql > "" Then
Adodc1.RecordSource = sql
Adodc1.Refresh
End If
If Adodc1.Recordset.RecordCount > 0 Then
For i = 0 To DataGrid1.Columns.Count - 1
newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
Next i
'指定表格内容
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
r = Adodc1.Recordset.AbsolutePosition
For c = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Col = c
newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
Next c
Adodc1.Recordset.MoveNext
Loop

Dim myval As Long
Dim mystr As String
myval = MsgBox("是否保存该Excel表?", vbYesNo, "提示窗口")
If myval = vbYes Then
mystr = InputBox("请输入文件名称", "输入窗口")
If Len(mystr) = 0 Then
MsgBox "系统不允许文件名称为空！", , "提示窗口"
Exit Sub
End If
On Error GoTo ErrSave
newsheet.SaveAs App.Path & "\Excel文件\" & mystr & ".xls"
MsgBox "Excel文件保存成功，位置：" & App.Path & "\Excel文件\" & mystr & ".xls", , "提示窗口"
newxls.Quit
ErrSave:
Exit Sub
MsgBox Err.Description, , "提示窗口"
End If
End If
End Sub

补充回答：因为路径不丰在，换一个存在的路径，不行就改成 App.Path & mystr & ".xls" 之类

利用VB.NET实现导出DataTable数据到excel中，各位大侠帮帮忙，最好有源码，谢谢，江湖救急

刚好写了个Helper类，你试验一下DataTable2Exce(这个方法代码如下：
Imports System.IO
Imports System.Data
Imports System.Data.OleDb

Public MustInherit Class ExcelHelper
Private Shared Function buildConnStr(excelFilePath As String) As String
Dim excelFileInfo As New System.IO.FileInfo(excelFilePath)
Dim constr As String
If excelFileInfo.Extension = ".xlsx" Then
constr = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=0;Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'", excelFilePath)
Else
constr = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=0;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'", excelFilePath)
End If
Return constr
End Function
'将datatable导入到excel
Public Shared Function DataTable2Excel(dt As DataTable, excelFilePath As String) As Boolean
If File.Exists(excelFilePath) Then
Throw New Exception("该文件已经存在！")
End If
If dt.TableName.Trim.Length = 0 Or dt.TableName.ToLower = "table" Then
dt.TableName = "Sheet1"
End If
Dim colCount As Integer = dt.Columns.Count
Dim pa(colCount - 1) As OleDb.OleDbParameter
Dim tableStructStr As String = "Create Table " & dt.TableName & "("
Dim connString As String = buildConnStr(excelFilePath)
Dim objconn As New OleDbConnection(connString)
Dim objcmd As New OleDbCommand
objcmd.Connection = objconn
Dim dataTypeList As New ArrayList
dataTypeList.Add("System.Decimal")
dataTypeList.Add("System.Double")
dataTypeList.Add("System.Int16")
dataTypeList.Add("System.Int32")
dataTypeList.Add("System.Int64")
dataTypeList.Add("System.Single")
Dim i As Integer = 0
For Each col As DataColumn In dt.Columns
If dataTypeList.IndexOf(col.GetType.ToString) > 0 Then
pa(i) = New OleDbParameter("@" & col.ColumnName, OleDbType.Double)
objcmd.Parameters.Add(pa(i))
If i + 1 = colCount Then
tableStructStr += col.ColumnName + " double)"
Else
tableStructStr += col.ColumnName + " double,"
End If
Else
pa(i) = New OleDbParameter("@" & col.ColumnName, OleDbType.VarChar)
objcmd.Parameters.Add(pa(i))
If i + 1 = colCount Then
tableStructStr += col.ColumnName + " VarChar)"
Else
tableStructStr += col.ColumnName + " VarChar,"
End If
End If
i += 1
Next
Try
objcmd.CommandText = tableStructStr
If objconn.State = ConnectionState.Closed Then objconn.Open()
objcmd.ExecuteNonQuery()
Catch ex As Exception
Throw ex
End Try
Dim InsertSql_1 As String = "Insert into " + dt.TableName + " ("
Dim InsertSql_2 As String = " Values ("
Dim InsertSql As String = ""
For colID As Integer = 0 To colCount - 1 Step 1
If colID + 1 = colCount Then
InsertSql_1 += dt.Columns(colID).ColumnName & ")"
InsertSql_2 += "@" + dt.Columns(colID).ColumnName + ")"
Else
InsertSql_1 += dt.Columns(colID).ColumnName + ","
InsertSql_2 += "@" + dt.Columns(colID).ColumnName + ","
End If
Next
InsertSql = InsertSql_1 + InsertSql_2
For rowID As Integer = 0 To dt.Rows.Count - 1 Step 1
For colID = 0 To dt.Columns.Count - 1
If pa(colID).DbType = DbType.Double And dt.Rows(rowID)(colID).ToString.Trim = "" Then
pa(colID).Value = 0
Else
pa(colID).Value = dt.Rows(rowID)(colID).ToString.Trim
End If
Next
Try
objcmd.CommandText = InsertSql
objcmd.ExecuteNonQuery()
Catch ex As Exception
Throw ex
End Try
Next
Try
If objconn.State = ConnectionState.Open Then objconn.Close()
Catch exp As Exception
Throw exp
End Try
Return True
End Function
' 获取Excel文件数据表列表Sheets
Public Shared Function GetExcelTables(ExcelFileName As String) As ArrayList
'Dim sheets As New List(Of String)
'conn.Open()
'Dim dt As DataTable = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, Nothing)
'For Each r In dt.Rows
' sheets.Add(r("TABLE_NAME"))
'Next
'conn.Close()
'Return sheets
Dim dt As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
Return Nothing
End If
Dim tableList As New ArrayList
Using conn As OleDbConnection = New OleDbConnection(buildConnStr(ExcelFileName))
Try
conn.Open()
dt = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, New Object() Nothing, Nothing, Nothing, "TABLE")
Catch ex As Exception
Throw ex
End Try
For i As Integer = 0 To dt.Rows.Count - 1
Dim tableName As String = dt.Rows(i)(2).ToString.Trim.TrimEnd("$")
If tableList.IndexOf(tableName) < 0 Then tableList.Add(tableName)
Next
End Using
Return tableList
End Function
'将Excel文件导出至DataTable(第一行作为表头)
Public Shared Function InputFromExcel(ExcelFileName As String, TableName As String) As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
End If
Dim tableList As ArrayList = GetExcelTables(ExcelFileName)
If tableList.IndexOf(TableName) < 0 Then
TableName = tableList(0).ToString.Trim
End If
Dim dt As New DataTable
Dim conn As New OleDbConnection(buildConnStr(ExcelFileName))
Dim cmd As New OleDbCommand("select * from [" & TableName & "$]", conn) '调试是否需要$
Dim adapter As New OleDbDataAdapter(cmd)
Try
If conn.State = ConnectionState.Closed Then conn.Open()
adapter.Fill(dt)
Catch ex As Exception
Throw ex
Finally
If conn.State = ConnectionState.Open Then conn.Close()
End Try
Return dt
End Function
'查询excel文件中的一个数据
Public Shared Function ReadOneDataFromExcel(ExcelFileName As String, TableName As String, sql As String) As Object
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
End If
Dim tableList As ArrayList = GetExcelTables(ExcelFileName)
If tableList.IndexOf(TableName) < 0 Then
TableName = tableList(0).ToString.Trim
End If
Dim dt As New DataTable
Dim conn As New OleDbConnection(buildConnStr(ExcelFileName))
Dim cmd As New OleDbCommand(sql, conn) '调试是否需要$
Dim ret As Object
Try
If conn.State = ConnectionState.Closed Then conn.Open()
ret = cmd.ExecuteScalar()
Catch ex As Exception
Throw ex
Finally
If conn.State = ConnectionState.Open Then conn.Close()
End Try
Return ret
End Function
'获取Excel文件指定数据表的数据列表columnNames
Public Shared Function GetExcelTableColumns(ExcelFileName As String, TableName As String) As ArrayList
Dim dt As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
Return Nothing
End If
Dim ColList As New ArrayList
Using conn As OleDbConnection = New OleDbConnection(buildConnStr(ExcelFileName))
Try
conn.Open()
dt = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, New Object() Nothing, Nothing, TableName, Nothing)
Catch ex As Exception
Throw ex
End Try
For i As Integer = 0 To dt.Rows.Count - 1
Dim ColName = dt.Rows(i)("Column_Name").ToString().Trim()
ColList.Add(ColName)
Next
End Using
Return ColList
End Function

End Class 参考技术A Public Shared Function ExportExceldr(ByVal Drv As DataTable, ByVal ECode As String) As Boolean
Dim BOO As Boolean = False '定义执行结果状态
If Drv Is Nothing OrElse Drv.Rows.Count = 0 Then '没有数据直接返回
Return BOO
End If
Dim SaveFileDialog1 As New SaveFileDialog '实例化文件保存提示框
SaveFileDialog1.Filter = "文件(*.xls)|*.xls" '设置保存文件类型
SaveFileDialog1.FileName = ECode '默认文件名
SaveFileDialog1.FilterIndex = 1 '默认筛选
SaveFileDialog1.InitialDirectory = Application.StartupPath '默认当前路径
If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then '用户点了确认
Try
Dim m_image As String = SaveFileDialog1.FileName '保存Excel路径和文件名称
Dim xlApp As Excel.Application = CreateObject("Excel.Application") '定义Excel对象
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Add() '新增工作簿
Dim sheet As Excel.Worksheet = xlBook.Worksheets(1) '定义工作表
Dim col As Integer = 0 '定义列
Dim row As Integer = 0 '定义行
Dim satData(,) As Object = New Object(Drv.Rows.Count, col) '定义二维数组给工作表赋值
For Each dl As DataColumn In Drv.Columns '按列开始循环赋值
row = 0 '行每次从0开始
ReDim Preserve satData(Drv.Rows.Count, col) '重新定义数据
satData(row, col) = dl.ColumnName '赋值列标题
For Each dr As DataRow In Drv.Rows '按行循环
row += 1 '下一行
satData(row, col) = dr(dl.ColumnName) '赋值表内容
Next
col += 1 '下一列
Next
row += 1 '再增加一行，因为包含标题行
sheet.Range(sheet.Cells(1, 1), sheet.Cells(row, col)).Value2 = satData '数组赋值到工作表区域
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col)).Font.Bold = True '标题行字体加粗
With sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col))
.Interior.ColorIndex = 34 '标题行加颜色
.Borders.LineStyle = 1 '加边框
.HorizontalAlignment = 3 '水平居中
.Font.Size = 10 '字体大小
.EntireColumn.AutoFit() '自动调整列宽
End With
sheet.Cells(2, 2).Activate() '激活单元格
sheet.Cells(2, 2).Application.ActiveWindow.FreezePanes = True '固定窗口
If xlBook.Sheets.Count > 1 Then
For i = xlBook.Sheets.Count To 2 Step -1
xlApp.DisplayAlerts = False
CType(xlBook.Worksheets(i), Excel.Worksheet).Delete() '删除多余工作表
Next
End If
xlBook.SaveAs(Filename:=m_image) '保存工作簿
xlApp.Visible = True '可以显示出来了
xlBook = Nothing '释放xlBook
xlApp = Nothing '释放xlApp对象
GC.Collect() '垃圾回收
Catch ex As Exception
MessageBox.Show(ex.ToString)
BOO = True
End Try
GC.Collect()
End If
Return BOO
End Function 参考技术B

. 我想你，不对，让我更正一下，我想念曾经的你，想念那个曾经会关心我的你。

本回答被提问者采纳 参考技术C 给个实例图片，我来帮你写