Dim rs As New ADODB.Recordset
Dim xlApp As Object
Dim xlSheet As Object
Dim DateStr, QDStr As String
Dim n, nRow As Long    DateStr = DateDialog.InputDate(, "交通规费征收计划执行情况表")
    If DateStr = "" Then GoTo ExitSub
    DateStr = Format(DateStr, "yyyy-MM-dd")
    info.info = "正在处理数据......"
    'WaitShow    Set rs = cn.Execute("f_SRJTGFZSJHmx '" & DateStr & "'")
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
    On Error GoTo ExitSub '0
    xlApp.Workbooks.Open FileName:=App.Path & "\fhtSOHO\交通规费征收计划执行情况表.xls"
    Set xlSheet = xlApp.ActiveWorkbook.Worksheets("fhtSOHO")    With xlSheet        .Cells(1, 1) = Format(DateStr, "yyyy年MM月") & "交通规费征收计划执行情况表"        With .PageSetup
            .CenterFooter = "制表人∶" & Pub_S_CzyName
            .RightFooter = "制表时间∶" & Format(Date, "yyyy年MM月dd日")
        End With        If rs.BOF And rs.EOF Then
        Else
            rs.MoveFirst
            nRow = 4
            QDStr = rs("费种") & ""            Do While Not rs.EOF
                If Trim(QDStr) = Trim(rs("费种") & "") Then
                    .Rows(nRow + 1 & ":" & nRow + 1).Select
                    .Application.Selection.Copy
                    .Rows(nRow + 1 & ":" & nRow + 1).Select
                    .Application.Selection.Insert Shift:=-4121
                    xlApp.ActiveWorkbook.Application.CutCopyMode = False                    .Cells(nRow, FAsc("A")) = rs("单位名称") & ""
                    .Cells(nRow, FAsc("B")) = rs("费种") & ""
                    .Cells(nRow, FAsc("C")) = rs("确保计划") & ""
                    .Cells(nRow, FAsc("D")) = rs("本月征收额") & ""
                    .Cells(nRow, FAsc("E")) = rs("累计征收额") & ""
                    .Cells(nRow, FAsc("F")) = rs("预计全年征收额") & ""
                    .Cells(nRow, FAsc("G")) = rs("完成进度") & ""
                    .Cells(nRow, FAsc("H")) = rs("增长额度") & ""
                Else
                    Trim(QDStr) = Trim(rs("费种") & "")                    .Rows(nRow & ":" & nRow + 1).RowHeight = 0
                    nRow = nRow + 3                    .Rows(nRow & ":" & nRow + 2).Select
                    .Application.Selection.Copy
                    .Rows(nRow & ":" & nRow).Select
                    .Application.Selection.Insert Shift:=-4121                    .Rows(nRow + 1 & ":" & nRow + 1).Select
                    .Application.Selection.Copy
                    .Application.Selection.Insert Shift:=-4121
                    xlApp.ActiveWorkbook.Application.CutCopyMode = False                    .Cells(nRow, FAsc("A")) = rs("单位名称") & ""
                    .Cells(nRow, FAsc("B")) = rs("费种") & ""
                    .Cells(nRow, FAsc("C")) = rs("确保计划") & ""
                    .Cells(nRow, FAsc("D")) = rs("本月征收额") & ""
                    .Cells(nRow, FAsc("E")) = rs("累计征收额") & ""
                    .Cells(nRow, FAsc("F")) = rs("预计全年征收额") & ""                End If                nRow = nRow + 1
                rs.MoveNext
            Loop            .Rows(nRow & ":" & nRow + 1).Select
            .Application.Selection.RowHeight = 0
            .Rows(nRow + 3 & ":" & nRow + 5).Select
            .Application.Selection.RowHeight = 0
            xlApp.ActiveWorkbook.Application.CutCopyMode = False
            .Rows("1:1").Select        End If    End With    'WaitHide
    info.Clear
    xlApp.Visible = True
    xlSheet.PrintPreview    With xlApp
        .ActiveWindow.View = 1
        .ActiveWorkbook.Saved = True
'        .Quit
    End With
Exit Sub
ExitSub:
    Set xlSheet = Nothing
    Set xlApp = Nothing
    Set rs = Nothing
    info.Clear

解决方案 »

  1.   

    Else
                        Trim(QDStr) = Trim(rs("费种") & "")                    .Rows(nRow & ":" & nRow + 1).RowHeight = 0
                        nRow = nRow + 3                    .Rows(nRow & ":" & nRow + 2).Select
                        .Application.Selection.Copy
                        .Rows(nRow & ":" & nRow).Select
                        .Application.Selection.Insert Shift:=-4121                    .Rows(nRow + 1 & ":" & nRow + 1).Select
                        .Application.Selection.Copy
                        .Application.Selection.Insert Shift:=-4121
                        xlApp.ActiveWorkbook.Application.CutCopyMode = False不是我懒,确实看不懂
      

  2.   

    cn.Execute("f_SRJTGFZSJHmx '" & DateStr & "'")
    这个是什么呀?调用了个函数?
      

  3.   

    看来好像是用存储过程来取数据,导入到EXCEL里,有什么问题吗?