mdlreport.bas

一个OA办公自动化管理系统

Attribute VB_Name = "MdlReport"
Option Explicit

Public Sub ExportGrid(StrCaption As String, RstRpt As ADODB.Recordset)
''On error goto Err_Menu
    Dim Ea                          As Excel.Application
    Dim Es                          As Excel.Worksheet
    Dim Eb                          As Excel.Workbook
    Dim i, j, s                     As String
    
    Set Ea = New Excel.Application
    Set Eb = Ea.Workbooks.Add(xlWBATWorksheet)
    Ea.Caption = "新思路软件"
    Set Es = Eb.ActiveSheet
    Es.name = StrCaption
    
    If RstRpt.RecordCount > 0 Then
        RstRpt.MoveFirst
    Else
        Exit Sub
    End If
    For i = 0 To RstRpt.RecordCount - 1
        For j = 1 To RstRpt.Fields.Count - 1
            If j <= 26 Then
                s = Chr(Asc("A") - 1 + j) & (i + 1)
                Es.Range(s) = RstRpt.Fields(j - 1).Value
            Else
                s = Chr(Asc("A") - 1 + Int(j \ 26)) & Chr(Asc("A") - 1 + (j Mod 26)) & (i + 1)
            End If
        Next
        RstRpt.MoveNext
    Next
    Ea.Visible = True
    
    Exit Sub
Err_Menu:
    mis_HandError Err.Number, "FrmDayIOS "
End Sub

Function GDateStr(ByVal Year As Integer, Optional ByVal Month As Integer, Optional ByVal Day As Integer) As String
''On error goto Err_Fun
    If Day <> 0 And Month <> 0 Then
        GDateStr = Year & LoadResString(Val("320" & GLanguageID)) & _
                  Month & LoadResString(Val("321" & GLanguageID)) & _
                  Day & LoadResString(Val("322" & GLanguageID))
    ElseIf Month <> 0 Then
        GDateStr = Year & LoadResString(Val("320" & GLanguageID)) & _
                  Month & LoadResString(Val("321" & GLanguageID))
    Else
        GDateStr = Year & LoadResString(Val("320" & GLanguageID))
    End If
    Exit Function
Err_Fun:
    mis_HandError Err.Number, "GDateStr"
End Function

Public Sub ReportDetail(StrSql As String, RptHead As String)
''On error goto Err_Report
    Const WidthMultiple = 200, WidthScale = 2
    Dim i, j, ColumnCount, Num                       As Integer
    Dim intWidth, IntLeft, NumWidth                  As Integer
    Dim RstDetail, RstSize, RstCorp                  As ADODB.Recordset
    Dim Rpt                                          As RptParentDetail
    Dim StrSqlSize, StrSqlCorp                       As String
    Dim StrField, StrCaption, StrName, StrValue      As String
    Dim BlnIsHave, BlnIsStr                          As Boolean
        
    Set RstDetail = New ADODB.Recordset
    Set RstSize = New ADODB.Recordset
    Set Rpt = New RptParentDetail
        
    RstDetail.Open StrSql, GetCNClient, adOpenKeyset, adLockOptimistic
    If RstDetail.RecordCount > 0 Then RstDetail.MoveFirst
        
    StrSqlSize = "SELECT DISTINCT Description,ID FROM Mis_Size WHERE Attribute=1 AND Size_Type" & _
                  " " & "IN (SELECT DISTINCT size_type From V_DayIOSDetail" & _
                  " " & "WHERE Year = " & Year(Date) & " AND PeriodNumber =" & Month(Date) & ") ORDER BY ID"
    RstSize.Open StrSqlSize, GetCNClient, adOpenKeyset, adLockOptimistic
    If RstSize.RecordCount > 0 Then RstSize.MoveFirst
    
    IntLeft = 0
    ColumnCount = 0
    BlnIsStr = False
    BlnIsHave = False
    With Rpt
        NumWidth = .Width - .PageLeftMargin - .PageRightMargin
        .DataControl1.Recordset = RstDetail
        
        .LabelHead.Caption = RptHead
        .LabelHead.Width = Len(RptHead) * WidthMultiple * WidthScale
        .LabelHead.Left = (.Width - .PageLeftMargin - .PageRightMargin - .LabelHead.Width) / 2
        
        If (Not RstDetail.EOF) And (Not RstDetail.BOF) Then
            For i = 1 To RstDetail.Fields.Count
                If i = 1 Then
                    If Len(RstDetail.Fields(i - 1).Value) < 4 Then
                        intWidth = (Len(RstDetail.Fields(i - 1).Value) + 1) * WidthMultiple
                    Else
                        intWidth = Len(RstDetail.Fields(i - 1).Value) * WidthMultiple / WidthScale
                    End If
                        
                    BlnIsHave = True
                    BlnIsStr = True
                    ColumnCount = ColumnCount + 1
                    
                    NumWidth = NumWidth - intWidth
                Else
                    If IsNumeric(RstDetail.Fields(i - 1).Value) Then
                        '根据数值宽度凋整报表列宽
                        'If Len(RstDetail.Fields(i - 1).Value) <= 3 Then
                        '    intWidth = WidthMultiple * WidthScale
                        'Else
                        '    intWidth = Len(RstDetail.Fields(i - 1).Value) * WidthMultiple
                        'End If
                                               
                        If (Not RstSize.EOF) And (Not RstDetail.BOF) Then
                            BlnIsHave = True
                            ColumnCount = ColumnCount + 1
                            StrValue = RstSize![ID]
                            StrCaption = RstSize![Description]
                            
                            intWidth = Int(NumWidth \ (RstSize.RecordCount))
                            RstSize.MoveNext
                        End If
                    Else
                        '根据数值宽度凋整报表列宽
                        If Len(RstDetail.Fields(i - 1).Value) < 4 Then
                            intWidth = (Len(RstDetail.Fields(i - 1).Value) + 1) * WidthMultiple
                        Else
                            intWidth = Len(RstDetail.Fields(i - 1).Value) * WidthMultiple / WidthScale
                        End If
                        
                        BlnIsHave = True
                        BlnIsStr = True
                        ColumnCount = ColumnCount + 1
                        
                        NumWidth = NumWidth - intWidth
                    End If
                End If
                
                If BlnIsHave Then
                    '初始化报表标题
                    With .PageHeader
                        StrName = "Label" & Trim(str(ColumnCount))
                        .Controls(StrName).Visible = True
                        If Not BlnIsStr Then .Controls(StrName).Caption = StrCaption
                        .Controls(StrName).Left = IntLeft
                        .Controls(StrName).Width = intWidth
                    End With
                    '初始化报表细目
                    With .Detail
                        If BlnIsStr Then
                            StrField = RstDetail.Fields(i - 1).name
                            StrName = "Field" & Trim(str(ColumnCount))
                            
                            .Controls(StrName).Visible = True
                            .Controls(StrName).DataField = StrField
                            .Controls(StrName).Left = IntLeft
                            .Controls(StrName).Width = intWidth
                            .Controls(StrName).OutputFormat = ("##,##0;-##,##0; ;")
                            .Controls(StrName).Height = .Controls(StrName).Height * 4
                            BlnIsStr = False
                        Else
                            Num = Int(Right(StrValue, 2))
                            For j = 0 To 3
                                Select Case j
                                Case 0: StrField = "Begin_D" & Trim(str(Num))
                                Case 1: StrField = "Income_D" & Trim(str(Num))
                                Case 2: StrField = "Outcome_D" & Trim(str(Num))
                                Case 3: StrField = "Balance_D" & Trim(str(Num))
                                End Select
                                            
                                StrName = "Field" & Trim(str(ColumnCount + j * 32))
                                .Controls(StrName).Visible = True
                                .Controls(StrName).DataField = StrField
                                .Controls(StrName).Left = IntLeft
                                .Controls(StrName).Width = intWidth
                                .Controls(StrName).OutputFormat = ("##,##0;-##,##0; ;")
                            Next j
                        End If
                    End With
                    '递增变量 IntLeft 用来调整 Left 属性
                    IntLeft = IntLeft + intWidth
                    
                    If i = 2 Then
                        With .Detail
                            For j = 1 To 4
                                StrName = "LabelDetail" & Trim(str(j))
                                .Controls(StrName).Left = IntLeft
                            Next j
                            intWidth = .Controls(StrName).Width
                        End With
                        .LabelDetail.Visible = True
                        .LabelDetail.Left = IntLeft
                        .LabelDetail.Width = intWidth
                        
                        IntLeft = IntLeft + intWidth
                        NumWidth = NumWidth - intWidth
                    End If
                End If
                BlnIsHave = False
            Next i
        End If
           
        '读取公司信息（名称，地址，电话，传真，Email）
        Set RstCorp = New ADODB.Recordset
        StrSqlCorp = "SELECT mis_Customer.ContactNum AS CorpID, mis_Customer.ContactName AS CorpName," & _
                   "Mis_City.captal, Mis_City.city, mis_Customer.Phone, mis_Customer.Fax, mis_Customer.Email, Mis_City.tel" & _
                   " " & "FROM mis_Customer INNER JOIN AccountName ON mis_Customer.ContactNum = AccountName.WrokCenter INNER JOIN" & _
                   " " & "Mis_City ON mis_Customer.City = Mis_City.City_ID" & _
                   " " & "WHERE AccountName.AccountID='" & Trim(strAccountName) & "'"
        RstCorp.Open StrSqlCorp, GetCNClient, adOpenKeyset, adLockOptimistic
        
        '初始化报表尾之公司信息
        If RstCorp.RecordCount > 0 Then
            RstCorp.MoveFirst
            
            .LabelFoot8 = RstCorp.Fields("CorpName")
            .LabelFoot10 = RstCorp.Fields("Captal") & RstCorp.Fields("city")
            .LabelFoot12 = "(" & RstCorp.Fields("Tel") & ")-" & RstCorp.Fields("Phone")
            .LabelFoot14 = RstCorp.Fields("Fax")
            .LabelFoot16 = RstCorp.Fields("Email")
        Else
        End If
                
        .Show 1
    End With
    
    '善后处理
    RstDetail.Close
    RstSize.Close
    RstCorp.Close
    Set RstDetail = Nothing
    Set RstSize = Nothing
    Set RstCorp = Nothing
    Set Rpt = Nothing
    Exit Sub
Err_Report:
    mis_HandError Err.Number, "GInitReport"
End Sub

Public Sub ReportEvidence(EvidenceNum As String, RptExcursus() As String)
''On error goto Err_Report
    Const WidthMultiple = 200, WidthScale = 2
    Dim i, NumberCount, TextCount                    As Integer
    Dim intWidth, IntLeft, NumWidth                  As Integer
    Dim RstDetail, RstSize, RstCorp, RstEviName      As ADODB.Recordset
    Dim Rpt                                          As RptEvidence
    Dim StrSql, StrSqlSize, StrSqlCorp, StrSqlEvi    As String
    Dim StrField, StrCaption, StrName                As String
    Dim BlnIsHave                                    As Boolean
        
    Set RstDetail = New ADODB.Recordset
    Set RstSize = New ADODB.Recordset
    Set RstEviName = New ADODB.Recordset
    Set Rpt = New RptEvidence
        
    StrSql = "SELECT Description,Q01,Q02,Q03,Q04,Q05,Q06,Q07,Q08,Q09,Q10,Q11,Q12,Q13," & _
                   "Q14,Q15,Q16,Q17,Q18,Q19,Q20,Q21,Q22,Q23,Q24,Q25,Q26,Q27,Q28,Q29,Q30 FROM V_EvidenceDetail" & _
                   " " & "WHERE Evidence_Number='" & EvidenceNum & "'"
    RstDetail.Open StrSql, GetCNClient, adOpenKeyset, adLockOptimistic