-

VB开发的ERP系统

            Str_Foreign = Trim(.LrText(3).Tag & "")
            Str_Department = Trim(.LrText(4).Tag & "")
            Str_Person = Trim(.LrText(5).Tag & "")
            
            '生成查询条件
            Str_QueryCondi = " where 1=1 and RPFlag = 'AR' and OverStatus=0 and BillItemCode in (20,21,11,10) and (StartFlag=0 or (startFlag=1 and Checker<>''))"
         
            For jsqte = 1 To 6
                Select Case jsqte
                    Case 1  '截止日期
                        If Trim(.LrText(0).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and BillDate <= '" & CDate(.LrText(0).Text) & "'"
                        End If
                    Case 2  '客户(起)
                        If Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode >= '" & Trim(.LrText(1).Tag) & "'"
                        End If
                    Case 3  '客户(止)
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode <= '" & Trim(.LrText(2).Tag) & "'"
                        End If
                    Case 4  '币别
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And ForeignCurrCode='" & Trim(.LrText(3).Tag) & "'"
                        End If
                    Case 5  '部门
                        If Trim(.LrText(4).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And DeptCode= '" & Trim(.LrText(4).Tag) & "'"
                        End If
                    Case 6 '经办人
                        If Trim(.LrText(5).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And PersonCode= '" & Trim(.LrText(5).Tag) & "'"
                        End If
                
                End Select
            
            Next jsqte
            
        End With
    Else
        '1-"刷新"查询
    End If
     
    Sqlstr = "SELECT PsCode,CusName,Sum(YbYsje)YbYsje ,Sum(BbYsje)BbYsje,Sum(YbCancelje)YbCancelje,Sum(BbCancelje)BbCancelje " & _
             " FROM Ar_v_AccMxList " & Str_QueryCondi & " Group By PsCode,CusName Order By PsCode"

    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("PsCode") & "")                            '客户编码
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")                           '客户名称
            If Str_Foreign <> "" Then
                If Val(.Fields("YbYsje")) <> Val(.Fields("YbCancelje")) Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Val(.Fields("YbYsje")) - Val(.Fields("YbCancelje"))  '原币应付金额
                End If
            Else
                If Val(.Fields("BbYsje")) <> Val(.Fields("BbCancelje")) Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Val(.Fields("BbYsje")) - Val(.Fields("BbCancelje"))  '本币应付金额
                End If
            End If
               
                '调用存储过程填充过期数值
                For TmpJsq = 0 To FillCol
                 
                    If TmpJsq <> FillCol Then
                        Str_Bill = "Ar_Sp_AccAgeAnalyse '" & Rec_Query!PsCode & "' ,'" & Str_Foreign & "','" & Str_Department & "','" & Str_Person & "','" & AccAge(TmpJsq) & "','" & AccAge(TmpJsq + 1) & "','" & Str_Date & "'"
                    Else
                        Str_Bill = "Ar_Sp_AccAgeAnalyse '" & Rec_Query!PsCode & "' ,'" & Str_Foreign & "','" & Str_Department & "','" & Str_Person & "','" & AccAge(TmpJsq) & "','" & -1 & "','" & Str_Date & "'"
                    End If
                    
                    Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Bill)
                    If Not Rec_Temp.EOF Then
                        With CxbbGrid
                            If Str_Foreign <> "" Then
                                If Val((Rec_Temp!GqNumberYb) & "") <> 0 Then
                                    .TextMatrix(jsqte, TmpJsq + 4) = Format(Val((Rec_Temp!GqNumberYb) & ""), "#,##0.00")            '过期金额
                                End If
                                GqTotal(TmpJsq) = GqTotal(TmpJsq) + Val(Rec_Temp!GqNumberYb & "")
                            Else
                                If Val((Rec_Temp!GqNumber) & "") <> 0 Then
                                    .TextMatrix(jsqte, TmpJsq + 4) = Format(Val((Rec_Temp!GqNumber) & ""), "#,##0.00")              '过期金额
                                End If
                                GqTotal(TmpJsq) = GqTotal(TmpJsq) + Val(Rec_Temp!GqNumber & "")
                            End If
                            
                        End With
                    End If
    
                Next TmpJsq
            '<<]
            
            '重新汇总客户余额
            If Str_Foreign <> "" Then
                TotalYe = TotalYe + .Fields("YbYsje") - .Fields("YbCancelje")
            Else
                TotalYe = TotalYe + .Fields("BbYsje") - .Fields("BbCancelje")
            End If
            
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd

            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
            
            If .EOF Then
                '填充合计金额
                CxbbGrid.AddItem ""
                CxbbGrid.RowHeight(jsqte) = Sjhgd
                CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = "  合  计"              '摘要
                CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = TotalYe                 '填充余额合计
                
                '填充过期合计数
                For TmpJsq = 0 To FillCol                                                           '填充过期余额合计
                    CxbbGrid.TextMatrix(jsqte, TmpJsq + 4) = Format(GqTotal(TmpJsq), "#,##0.00")
                Next TmpJsq
                
                '设置合计行颜色
                CxbbGrid.Cell(flexcpBackColor, jsqte, 0, , CxbbGrid.Cols - 1) = "&H00F7F3EC"
                jsqte = jsqte + 1
                
                '填充占总金额比例
                CxbbGrid.AddItem ""
                CxbbGrid.RowHeight(jsqte) = Sjhgd
                CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = "  占总额(%)"           '摘要
                CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "100"                   '余额百分比
                
                If TotalYe <> 0 Then
                    For TmpJsq = 0 To FillCol                                                       '填充过期余额百分比
                        CxbbGrid.TextMatrix(jsqte, TmpJsq + 4) = Format(GqTotal(TmpJsq) / TotalYe * 100, "#,##0.00")
                    Next TmpJsq
                End If
                
                '设置余额百分比记录行颜色
                CxbbGrid.Cell(flexcpBackColor, jsqte, 0, , CxbbGrid.Cols - 1) = "&H00C0E0FF"
                
            End If
        Loop
        
    End With

    ']以上为用户自定义部分

End Sub

'填充网格表头数据内容
Private Sub Sub_FillGrid(Str_Grid As String)
    
    Dim Rec_FillGrid As New Recordset               '网格列标题动态集
    Dim jsq As Integer, Rowjsq As Integer
    Dim Coljsq As Integer
    Dim ArrayNum As Integer
    
    '打开账龄区间设置动态集
    Set Rec_FillGrid = Cw_DataEnvi.DataConnect.Execute(Str_Grid)
    FillCol = Rec_FillGrid.RecordCount
    If FillCol < 1 Then Exit Sub
    
        '根据帐龄区间设置各个帐龄分析区间段的最小值
        '<<
        ReDim AccAge(FillCol) As Single
    
        Rec_FillGrid.MoveFirst
        ArrayNum = 0
        Do While Not Rec_FillGrid.EOF
            ArrayNum = ArrayNum + 1
            AccAge(ArrayNum) = Trim(Rec_FillGrid.Fields("MinBillAge") & "")
            Rec_FillGrid.MoveNext
        Loop
        '>>
    
    '填充网格表头数据
    Rec_FillGrid.MoveFirst
    With CxbbGrid
        '设置网格属性
        .BackColorFixed = &H8000000F                                           '固定行背景色 ('&H80000018)
        .Cols = Qslz + 4 + Rec_FillGrid.RecordCount
        .AllowUserResizing = flexResizeBoth
        .SelectionMode = flexSelectionByRow
        .ExplorerBar = flexExNone                                              '网格列是否可移动及排序
        .ScrollTips = True
        .WordWrap = True
        
        For jsq = Qslz To .Cols - 1
            .ColHidden(jsq) = False
        Next jsq
        
        '填 充 网 格 标 题
        For Rowjsq = 0 To .FixedRows - 1
            If Rowjsq = 0 Then
                .MergeRow(Rowjsq) = True
                .RowHeight(Rowjsq) = Sjhgd * 1.8
                .TextMatrix(Rowjsq, Qslz) = "客户编码"
                .TextMatrix(Rowjsq, Qslz + 1) = "客户名称"
                .TextMatrix(Rowjsq, Qslz + 2) = "余额"
                .TextMatrix(Rowjsq, Qslz + 3) = "未到期"
                
                .TextMatrix(Rowjsq + 1, Qslz) = "客户编码"
                .TextMatrix(Rowjsq + 1, Qslz + 1) = "客户名称"
                .TextMatrix(Rowjsq + 1, Qslz + 2) = "余额"
                .TextMatrix(Rowjsq + 1, Qslz + 3) = "未到期"
                
                BeginCol = Qslz + 4             '定义起始列
                
                '从数据表填充网格列
                If Not Rec_FillGrid.EOF Then
                    Rec_FillGrid.MoveFirst
                    For Coljsq = (Qslz + 4) To (.Cols - 1)
                        .TextMatrix(Rowjsq, Coljsq) = "过期天数"
                        .TextMatrix(Rowjsq + 1, Coljsq) = Trim(Rec_FillGrid.Fields("BEDays") & "")
                        Rec_FillGrid.MoveNext
                    Next Coljsq
                End If
            
            End If
        Next Rowjsq
        
        '数 据 网 格 高 度
        For Rowjsq = 0 To .FixedRows - 1
            .RowHeight(Rowjsq) = 250
        Next Rowjsq
        
         '定 义 录 入 字 段 属 性
        For Coljsq = (Qslz + 4) To .Cols - 1
            .MergeCol(Coljsq) = True
            .ColAlignment(Coljsq) = flexAlignRightTop
            .FixedAlignment(Coljsq) = flexAlignCenterCenter

        Next Coljsq
             
        '定义网格列宽度
        For Coljsq = 4 To .Cols - 1
            .ColWidth(Coljsq) = Sjhgd * 5
        Next Coljsq
    
    End With

End Sub

'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 2                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    Bbxbt(1) = Space(2) + Fun_FormatOutPut(Lab_Dept, 28) + Fun_FormatOutPut(Lab_Person, 28) + Fun_FormatOutPut(Lab_Foreign, 28) + Fun_FormatOutPut(Lab_Date, 28)
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub