datagrid 中的数据可以生成Excel 吗? 怎样实现?

解决方案 »

  1.   

    Public Function ExporToExcel(strOpen As String)
    '*********************************************************
    '* 名称:ExporToExcel
    '* 功能:导出数据到EXCEL
    '* 用法:ExporToExcel(sql查询字符串)
    '*********************************************************
    Dim Rs_Data As New ADODB.Recordset
    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
        
        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
        
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = NothingEnd Function该怎样用????????????????????????????????????
    为何老是报错?
      

  2.   

    .open 处“没有为命令对象设置命令”