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
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
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不是我懒,确实看不懂
这个是什么呀?调用了个函数?