当前位置:编程学习 > VB >>

VB导出EXECL提示无效的过程调用或参数

Public Function SJDC(RSrecord As ADODB.Recordset)
On Error GoTo Err1
Dim Rs_Data     As New ADODB.Recordset
'Dim conn As ADODB.Connection
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 xlApp     As Object
Dim xlBook     As Object
Dim xlSheet     As Object
Dim xlQuery     As Object
'   假设Rs_Data   是你的记录集
With RSrecord
If .RecordCount < 1 Then
MsgBox "没有可导出的记录! ", vbInformation + vbOKOnly, "提示 "
Exit Function
End If
'记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .fields.Count
End With
'Set conn = New ADODB.Connection
 
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=123;Initial Catalog=UFDATA_997_2011;Data Source=192.168.188.128;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=XZL;Use Encryption for Data=False;Tag with column collation when possible=False"
Rs_Data.open RSrecord.Source, pobjConn, adOpenStatic
       Set xlApp = CreateObject("Excel.Application")
'       Set xlApp = New 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 = 1 '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 = 1 'xlContinuous                '设表格边框样式
        '   .PageSetup.PaperSize   =   xlPaperA4
        '              '   .PageSetup.PrintGridlines   =   True
        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
        Rs_Data.Close
'        conn.Close
        '        xlApp.SaveWorkspace "c:\错误文件.xls"
        Set xlApp = Nothing           ' "交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = Nothing
      Set Rs_Data = Nothing
'        Set conn = Nothing
        Exit Function
Err1:             MsgBox Error & ",Excel 未安装! "
        End Function --------------------编程问答-------------------- 不一定根代码有关系,EXCEL表是否规范。
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,