-

VB开发的ERP系统

End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
 
    '生成查询结果
    Call Sub_Query(0)
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

End Sub

Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Integer                        '临时动态计数器
    Dim TempForCur As String                    '临时币别代码
    Dim BanTotal(8) As Single                   '计算供应商余额合计

    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With Report_FrmSuppQuery
            
            '填充表头部门内容
            Report_FrmSuppList.Lab_Dept = "部门: " & .LrText(3).Text
            Report_FrmSuppList.Lab_Person = "经办人: " & .LrText(4).Text
            Report_FrmSuppList.Lab_Kjqj = "会计期间: " & .Cmb_Kjqj.Text
            If Trim(.LrText(2).Text) <> "" Then
                Report_FrmSuppList.Lab_Foreign = "币别: " & .LrText(2).Text
                TempForCur = Trim(.LrText(2).Tag)
            Else
                Report_FrmSuppList.Lab_Foreign = "币别: " & XtSCurrName
                TempForCur = XtSCurrCode
            End If
            
            '生成查询条件
            Str_QueryCondi = " where 1=1 and RPFlag = 'AP' "
         
            For Jsqte = 1 To 6
                Select Case Jsqte
                    Case 1  '会计期间
                        If Trim(.Cmb_Kjqj.Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and KjYear = " & Val(Mid(.Cmb_Kjqj.Text, 1, 4)) & " And Period = " & Val(Mid(.Cmb_Kjqj.Text, 6, 2))
                        End If
                    Case 2  '供应商(起)
                        If Trim(.LrText(0).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode >= '" & Trim(.LrText(0).Tag) & "'"
                        End If
                    Case 3  '供应商(止)
                        If Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode <= '" & Trim(.LrText(1).Tag) & "'"
                        End If
                    Case 4  '币别
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And ForeignCurrCode='" & Trim(.LrText(2).Tag) & "'"
                        End If
                    Case 5  '部门
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And DeptCode= '" & Trim(.LrText(3).Tag) & "'"
                        End If
                    Case 6 '经办人
                        If Trim(.LrText(4).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And PersonCode= '" & Trim(.LrText(4).Tag) & "'"
                        End If
                
                End Select
            Next Jsqte
        End With
    Else
        '1-"刷新"查询
    End If
     
    Sqlstr = "SELECT PsCode,SupplierName,Sum(YbNcye)YbNcye ,Sum(YbQcye)YbQcye,Sum(YbYsje)YbYsje,Sum(YbSsje)YbSsje, " & _
             " Sum(YbQmye)YbQmye,Sum(BbNcye)BbNcye,Sum(BbQcye)BbQcye,Sum(BbYsje)BbYsje,Sum(BbSsje)BbSsje, " & _
             " Sum(BbQmye)BbQmye FROM Ap_V_AccSumList " & Str_QueryCondi & " Group By PsCode,SupplierName Order By PsCode,SupplierName"

    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("SupplierName") & "")       '供应商名称
            
            '期初借贷(应付与应付方向相反)
            Select Case Val(.Fields!BbQcye)                                                                      '借贷方向
                Case Is > 0
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "贷"
                Case Is < 0
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "借"
                Case Else
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "平"
            End Select
            If Val(.Fields!BbQcye) <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Abs(Val(.Fields("BbQcye")))          '本币期初余额
            End If
            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(Val(.Fields("BbYsje")))              '本币应付金额
            CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Val(Val(.Fields("BbSsJe")))              '本币实付金额
            
            Select Case Val(.Fields!BbQmye)                                                                      '期末余额方向
                Case Is > 0
                    CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "贷"
                Case Is < 0
                    CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "借"
                Case Else
                    CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "平"
            End Select
            
            If Val(.Fields!BbQmye) <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Abs(Val(.Fields("BbQmye")))          '本币期末余额
            End If
            
            If TempForCur <> XtSCurrCode Then
                If Val(.Fields!BbQcye) <> 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Abs(Val(.Fields("YbQcye")))      '原币期初余额
                End If
                CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(Val(.Fields("YbYsje")))          '原币应付金额
                CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(Val(.Fields("YbSsje")))          '原币实付金额
                If Val(.Fields!BbQmye) <> 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Abs(Val(.Fields("YbQmye")))      '原币期末余额
                End If
            End If

            '<<]
            '计算供应商余额合计
            BanTotal(1) = BanTotal(1) + .Fields("YbQcye")
            BanTotal(2) = BanTotal(2) + .Fields("BbQcye")
            BanTotal(3) = BanTotal(3) + .Fields("YbYsje")
            BanTotal(4) = BanTotal(4) + .Fields("Bbysje")
            BanTotal(5) = BanTotal(5) + .Fields("YbSsje")
            BanTotal(6) = BanTotal(6) + .Fields("BbSsje")
            BanTotal(7) = BanTotal(7) + .Fields("YbQmye")
            BanTotal(8) = BanTotal(8) + .Fields("BbQmye")
            '设置数据行高度(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)) = "  合  计"
                If BanTotal(2) <> 0 Then            '期初余额方向(与应付方向相反)
                    If BanTotal(2) > 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "贷"
                    Else
                        CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "借"
                    End If
                Else
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "平"
                End If
                
                If BanTotal(1) <> 0 And TempForCur <> XtSCurrCode Then                                           '原币期初余额
                    CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Abs(BanTotal(1))
                End If
                If BanTotal(2) <> 0 Then                                                                         '本币期初余额
                    CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Abs(BanTotal(2))
                End If
                If TempForCur <> XtSCurrCode Then                                                                '原币本期应付
                    CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(BanTotal(3))
                End If
                    
                CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(BanTotal(4))                     '本币本期应付
                
                If TempForCur <> XtSCurrCode Then                                                                '原币本期实付
                    CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(BanTotal(5))
                End If
                                                                        
                CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Val(BanTotal(6))                     '本币本期实付
                
                If BanTotal(8) <> 0 Then                                                                         '期末余额方向
                    If BanTotal(8) > 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "贷"
                    Else
                        CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "借"
                    End If
                Else
                    CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = "平"
                End If
                
                If BanTotal(7) <> 0 And TempForCur <> XtSCurrCode Then                                           '原币期末余额
                    CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Abs(BanTotal(7))
                End If
                If BanTotal(8) <> 0 Then                                                                         '本币期末余额
                    CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Abs(BanTotal(8))
                End If
                
                 '合计清零
                For I = 1 To 8
                    BanTotal(I) = 0
                Next I
                CxbbGrid.Cell(flexcpBackColor, Jsqte, 0, , CxbbGrid.Cols - 1) = "&H00F7F3EC"
                Jsqte = Jsqte + 1
            End If
        Loop
        
    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, 25) + Fun_FormatOutPut(Lab_Person, 25) + Fun_FormatOutPut(Lab_Kjqj, 25) + Fun_FormatOutPut(Lab_Foreign, 25)
    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