datagrid的问题

[flashrain]

datagrid可否导出到EXECL

[flashrain]

up

[地狱余烬]

得引用Microsoft Excel 9.0 Object Library
用 记录集就行 自定义过程如下


Public Sub ProCopyAdoRsToExcel(SAdoRsTmp As ADODB.Recordset, SheetName As String)

Dim appExcel As Excel.Application '通用EXCEL对象
Dim wbExcel As Excel.Workbook '指定EXCEL对象
Dim TempSheet As Excel.Worksheet '工作单对象
Dim TempRange As Excel.Range '限制行

Dim LongRow As Long, LongCol As Long '循环变量

If Not (SAdoRsTmp.EOF Or SAdoRsTmp.BOF) Then
SAdoRsTmp.MoveFirst: SAdoRsTmp.MoveFirst
Set appExcel = CreateObject("excel.application")
Set wbExcel = appExcel.Workbooks.Open("d:\tj.xls") '打开文件
Set TempSheet = appExcel.Worksheets(SheetName)
TempSheet.Cells.Clear '清空现有数据
LongRow = 0
Set TempRange = TempSheet.Rows(LongRow + 1)

'标题
Do While LongCol <= SAdoRsTmp.Fields.Count - 1
TempRange.Cells(LongRow + 1, LongCol + 1) = CStr(SAdoRsTmp.Fields(LongCol).Name)
LongCol = LongCol + 1
Loop

'内容
LongRow = 1
Do While LongRow <= SAdoRsTmp.RecordCount
LongCol = 0
Do While LongCol <= SAdoRsTmp.Fields.Count - 1
If Not IsNull(SAdoRsTmp.Fields(LongCol)) Then
TempRange.Cells(LongRow + 1, LongCol + 1) = CStr(SAdoRsTmp.Fields(LongCol))
End If
LongCol = LongCol + 1
Loop
LongRow = LongRow + 1
SAdoRsTmp.MoveNext
Loop

Set TempSheet = Nothing '关闭对象
wbExcel.Save
wbExcel.Close
Set wbExcel = Nothing
Set appExcel = Nothing
End If

End Sub

[gunmanpan]

用DATA控件进行连接，
data控件的属性设置如下：
connect:excel8.0
databasename:手动选定
recordsource:用动选定哪个sheet
用ADO我没试，你试吧！

[flashrain]

按扭事件里如何写？

[flashrain]

up

[mingtian2008]

up

[flashrain]

up

[wxrwan]

up

[ygs202]

用True DBgrid控件直接可以达到目的

[mingtian2008]

哈哈 我前几天也遇到类似的问题 我是这样做的 功能已经实现了 可能挺苯的,你看看。

"前提"你的数据库 必须不要有什么限制？（不要有必须字段，不要有不允许为空）


"Call ConRe 是连接 Microsoft Access 表 我想不用我多说了吧？在这里我就不写了"
过程名后的是一些参数，你可以修改以下。

Public conexl As ADODB.Connection
Public reexl As ADODB.Recordset
Public appexl As Excel.Application
Public workexl As Excel.Workbook
Public workexlsh As Excel.Worksheet
Public rowexl As Excel.Range

Public Sub ConReExcel(PathOpen1 As String) 连接Excel
Set conexl = New ADODB.Connection
conexl.Open "provider=microsoft.jet.oledb.4.0;data source= " & PathOpen1 & " ;extended properties=excel 8.0;"
conexl.CursorLocation = adUseClient
Set reexl = New Recordset
End Sub

数据导出
Public Sub Excel_o(Table_Name As String, Data_Table As DataGrid, TitleString As String, PathSave As String)
Call ConRe
re.Open "select * from " & Table_Name & "", con, adOpenDynamic, adLockBatchOptimistic

If Data_Table.ApproxCount + 1 > 0 Then

Set appexl = New Excel.Application

Set workexl = appexl.Workbooks.Add

Set workexlsh = workexl.Worksheets.Add
workexlsh.Name = TitleString
Set rowexl = workexlsh.Rows(1)

For i = 1 To Data_Table.Columns.Count
Data_Table.Row = 0
rowexl.Cells(1, i) = re.Fields(i - 1).Name

Next

On Error Resume Next

For j = 0 To Data_Table.ApproxCount - 1

For i = 1 To Data_Table.Columns.Count
Data_Table.Col = i - 1
rowexl.Cells(j + 2, i) = Data_Table.Text


Next
Data_Table.Row = Data_Table.Row + 1
Next

workexlsh.SaveAs PathSave
appexl.Quit
End If
End Sub

数据导入
Public Sub Excel_I(Table_Name As String, Table_Name_exl As String, Data_Table As DataGrid, pathopen As String)
Call ConReExcel(pathopen)
reexl.Open "select * from [" & Table_Name_exl & "$] order by 还阅编号 ", conexl, adOpenDynamic, adLockBatchOptimistic

Set Data_Table.DataSource = reexl

Call ConRe

Data_Table.Row = 0
On Error Resume Next
For j = 0 To Data_Table.ApproxCount


Data_Table.Col = 0
sql1 = "insert into " & Table_Name & "( " & reexl.Fields(0).Name & ") values ('" & Data_Table.Text & "') "
Bianhao = Data_Table.Text
con.Execute sql1

For i = 1 To Data_Table.Columns.Count - 1
Data_Table.Col = i
Sql = "update " & Table_Name & " set " & reexl.Fields(i).Name & "='" & Data_Table.Text & "' where 还阅编号='" & Bianhao & "' "
con.Execute Sql
Next i

Data_Table.Row = Data_Table.Row + 1

Next j

MsgBox "数据成功导入！ ", vbInformation, "数据导入提示 "

Call TuShu_LiShiJiLu
Call TuShu_TongJi

End Sub

[mingtian2008]

不好意思 下面的 是我自己做的时候 定义的过程
Call TuShu_LiShiJiLu
Call TuShu_TongJi