mdlreport

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

Attribute VB_Name = "MdlReport"
Option Explicit

Public Sub ReportDetail(StrSql As String, RptHead As String)
''On error goto Err_Report
    Const WidthMultiple = 200, WidthScale = 2
    Dim i, j, intWidth, IntLeft, ColumnCount, Num    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
        
    'StrSql = "SELECT Description,StockDescription,Begin_D1,Begin_D2,Begin_D3,Begin_D4,Begin_D5,Begin_D6,Begin_D7," & _
           "Begin_D8,Begin_D9,Begin_D10,Begin_D11,Begin_D12,Begin_D13,Begin_D14,Begin_D15,Begin_D16,Begin_D17," & _
           "Begin_D18,Begin_D19,Begin_D20,Begin_D21,Begin_D22,Begin_D23,Begin_D24,Begin_D25,Begin_D26,Begin_D27," & _
           "Begin_D28,Begin_D29,Begin_D30,Income_D1,Income_D2,Income_D3,Income_D4,Income_D5,Income_D6,Income_D7," & _
           "Income_D8,Income_D9,Income_D10,Income_D11,Income_D12,Income_D13,Income_D14,Income_D15,Income_D16,Income_D17," & _
           "Income_D18,Income_D19,Income_D20,Income_D21,Income_D22,Income_D23,Income_D24,Income_D25,Income_D26,Income_D27," & _
           "Income_D28,Income_D29,Income_D30,Outcome_D1,Outcome_D2,Outcome_D3,Outcome_D4,Outcome_D5,Outcome_D6,Outcome_D7," & _
           "Outcome_D8,Outcome_D9,Outcome_D10,Outcome_D11,Outcome_D12,Outcome_D13,Outcome_D14,Outcome_D15,Outcome_D16,Outcome_D17," & _
           "Outcome_D18,Outcome_D19,Outcome_D20,Outcome_D21,Outcome_D22,Outcome_D23,Outcome_D24,Outcome_D25,Outcome_D26,Outcome_D27," & _
           "Outcome_D28,Outcome_D29,Outcome_D30,Balance_D1,Balance_D2,Balance_D3,Balance_D4,Balance_D5,Balance_D6,Balance_D7," & _
           "Balance_D8,Balance_D9,Balance_D10,Balance_D11,Balance_D12,Balance_D13,Balance_D14,Balance_D15,Balance_D16,Balance_D17," & _
           "Balance_D18,Balance_D19,Balance_D20,Balance_D21,Balance_D22,Balance_D23,Balance_D24,Balance_D25,Balance_D26,Balance_D27," & _
           "Balance_D28,Balance_D29,Balance_D30 FROM V_DayBuySellStockDetail WHERE Year=" & Year(Date) & " AND PeriodNumber=" & Month(Date) & ""
    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_DayBuySellStockDetail" & _
                  " " & "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
        .DataControl1.Recordset = RstDetail
        
        .LabelHead.Caption = RptHead
        .LabelHead.Width = Len(RptHead) * WidthMultiple * WidthScale
        .LabelHead.Left = (.Width - .LabelHead.Width) / 2
        
        If (Not RstDetail.EOF) And (Not RstDetail.BOF) Then
            For i = 1 To RstDetail.Fields.Count
                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 RstSize.BOF) Then
                        BlnIsHave = True
                        ColumnCount = ColumnCount + 1
                        StrValue = RstSize![ID]
                        StrCaption = RstSize![Description]
                        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
                    End If
                    
                    BlnIsHave = True
                    BlnIsStr = True
                    ColumnCount = ColumnCount + 1
                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
                    End If
                End If
                BlnIsHave = False
            Next i
        End If
        
        With .LineHead
            .x1 = IntLeft
            .x2 = IntLeft
        End With
        With .LineVertical
            .x1 = IntLeft
            .x2 = IntLeft
            .Y1 = 0
            .Y2 = 250 * RstDetail.RecordCount
        End With
        With .LineHorizontal
            .x1 = 0
            .x2 = IntLeft
        End With
        
        '读取公司信息（名称，地址，电话，传真，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 ReportModel(EvidenceNum As String, RptExcursus() As String)
''On error goto Err_Report
    Const WidthMultiple = 200
    Dim i, NumberCount, TextCount                    As Integer
    Dim intWidth, IntLeft, NumWidth                  As Integer
    Dim RstDetail, RstSize, RstCorp, RstEviName      As ADODB.Recordset
    Dim Rpt                                          As RptModel
    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 RptModel
        
    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
    If RstDetail.RecordCount > 0 Then RstDetail.MoveFirst
        
    '读取有效配码
    StrSqlSize = "SELECT DISTINCT Description,ID FROM Mis_Size WHERE Attribute=1 AND Size_Type" & _
                  " " & "IN (SELECT Size_Type FROM V_EvidenceDetail WHERE Evidence_Number='" & _
                  EvidenceNum & "'" & ") ORDER BY ID"
    RstSize.Open StrSqlSize, GetCNClient, adOpenKeyset, adLockOptimistic
    If RstSize.RecordCount > 0 Then RstSize.MoveFirst
    '读取单据名称及日期
    StrSqlEvi = " SELECT Evidence_Type.Description AS EvidenceName, Inventory_Evidence.Date " & _
              " " & "FROM Evidence_Type INNER JOIN" & _
              " " & "Inventory_Evidence ON Evidence_Type.Type = Inventory_Evidence.Type" & _
              " " & "WHERE Inventory_Evidence.Evidence_Number = '" & EvidenceNum & "'"
    RstEviName.Open StrSqlEvi, GetCNClient, adOpenKeyset, adLockOptimistic
    If RstEviName.RecordCount > 0 Then
        RstEviName.MoveFirst
    Else
        Exit Sub
    End If
    IntLeft = 0
    NumberCount = 0
    TextCount = 0
    With Rpt
        .DataControl1.Recordset = RstDetail
        
        '初始化报表头之单据号,日期,名称
        If (Not RstEviName.EOF) And (Not RstEviName.BOF) Then
            .LabelHead = RstEviName![EvidenceName]
            .LabelHead8 = EvidenceNum
            .LabelHead10 = Format(RstEviName![Date], "yyyy-mm-dd")
        End If
        
        '初始化报表头之附加区(具体内容由参数 RptTitle 传进)
        If UBound(RptExcursus) > 0 Then
            .Shape1.Visible = True
            .Shape1.Width = .Width
        End If