导出的问题

Question

怎么样把DATAGIRD中的数据导出到EXCEL或者WORD中去。望各位大侠帮帮我吧，分不够再加，最好有代码。谢谢了。

Answer 1

我这有个从listview网格-->excel的代码,稍修改就好,代码太多,qq联系(2521159)

Answer 2

Public Function ExporToExcel(strOpen As String, strAppPath As String, sFileName As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(strOpen-sql查询字符串,sFileName-文件名)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
    On Error Resume Next
    Dim Irowcount As Integer
    Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    Dim ExclFileName As String
    Dim i As Integer
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
'    With xlSheet.PageSetup
'        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称："   ' & Gsmc
'        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
'        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
'        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
'        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
'        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
'    End With
'
 '   ExclFileName = App.Path & "\Excel\" & Date & sFileName & ".xls"
    ExclFileName = strAppPath & Date & sFileName & ".xls"
    i = 1
Sign:   If Dir(ExclFileName) <> "" Then
            'Kill ExclFileName
            'ExclFileName = App.Path & "\Excel\" & Date & sFileName & i & ".xls"
            ExclFileName = strAppPath & Date & sFileName & i & ".xls"
            i = i + 1
            GoTo Sign
        End If
        
'    xlApp.Application.Visible = True      '"交还控制给Excel
'    xlApp.WindowState = xlMaximized
    xlBook.SaveAs (ExclFileName)
    xlApp.Quit
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    
    Exit Function
Err_Folder:
    If Err.Number = 1004 Then
        MsgBox Err.Description
        MkDir strAppPath
        Resume
    Else
        Resume Next
    End If
End Function

Answer 3

函数可以直接调用
  ExporToExcel strSql, App.Path & "\Excel\", "运费统计"
（上面的函数，是我转载的，我一直这么用，熟读还可以阿）

Answer 4

谢谢了我想问一下strOpen-sql查询字符串在函数中怎么没看到呀，可以解释一下吗？真的很感谢你。希望你能继续帮我。交个朋友了。我的MSN是[email protected]，QQ是199142179。

Answer 5

to frankwong(黄梓钿) 
我可以学习学习你的那个代码吗？
我已发出请求你的QQ通过

Answer 6

谁来帮帮我呀。求求你们了。THANK YOU!