datagrid的问题

Question

datagrid可否导出到EXECL

Answer 1

得引用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 IfEnd Sub

Answer 2

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

Answer 3

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

Answer 4

哈哈 我前几天也遇到类似的问题 我是这样做的 功能已经实现了 可能挺苯的,你看看。"前提"你的数据库 必须不要有什么限制？（不要有必须字段，不要有不允许为空）
 "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.RangePublic 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

Answer 5

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