-

VB开发的ERP系统

    XtReportCode = "Chhs_InOutClassSum"
    Load Dyymctbl
      
    '调整标题栏及网格、格式工具条位置(Fixed)
    Pic_Title.Left = 40
    Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
     
    '调 入 网 格(Fixed)
    GridCode = "Chhs_InOutClassSum"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载

    '卸载条件窗体
    Tjfx_InOutClassSumCond.UnloadCheck.Value = 1
    Unload Tjfx_InOutClassSumCond
    
    '卸载打印页面设置窗体
    Unload Dyymctbl

End Sub

Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)                '网格格式调整(Fixed)
  
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(CxbbGrid, GridCode)
            With CxbbGrid
                If GridCode = "Chhs_InOutClassSum" Then
                    For Jsqte = Sydz("005", GridStr(), .Cols - 1) + 1 To .Cols - 3 Step 3
                        .ColHidden(Jsqte) = .ColHidden(Sydz("003", GridStr(), Szzls))
                        .ColHidden(Jsqte + 1) = .ColHidden(Sydz("004", GridStr(), Szzls))
                        .ColHidden(Jsqte + 2) = .ColHidden(Sydz("005", GridStr(), Szzls))
                    Next Jsqte
                End If
            End With
    End Select

End Sub

Private Sub Sub_GridHead()            '网格表头调整(汇总条件索引）
Dim Rectemp As Recordset
Dim RecTempFz As New ADODB.Recordset
Dim Coljsq As Integer
Dim InOutFlag As Boolean

    '更新双表头
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select inoutclassname ,inoutflag from gy_inoutclass order by inoutflag desc, inoutclasscode")
    If Not Rectemp.EOF Then
        
        With CxbbGrid
            Coljsq = Szzls + 1
            .Cols = Coljsq + Rectemp.RecordCount * 3 + 3
            
            Do While Not Rectemp.EOF
                
                '无出库分类
                If Not Rectemp.Fields("inoutflag") And InOutFlag = True Then
                    .TextMatrix(0, Coljsq) = "无出库类别"
                    .TextMatrix(0, Coljsq + 1) = "无出库类别"
                    .TextMatrix(0, Coljsq + 2) = "无出库类别"
                    .TextMatrix(1, Coljsq) = "数量"
                    .TextMatrix(1, Coljsq + 1) = "单价"
                    .TextMatrix(1, Coljsq + 2) = "金额"
                    .ColAlignment(Coljsq) = 6
                    .ColAlignment(Coljsq + 1) = 6
                    .ColAlignment(Coljsq + 2) = 6
                    .FixedAlignment(Coljsq) = flexAlignCenterCenter
                    .FixedAlignment(Coljsq + 1) = flexAlignCenterCenter
                    .FixedAlignment(Coljsq + 2) = flexAlignCenterCenter
                    .ColFormat(Coljsq) = .ColFormat(Sydz("003", GridStr(), .Cols - 1))
                    .ColFormat(Coljsq + 1) = .ColFormat(Sydz("004", GridStr(), .Cols - 1))
                    .ColFormat(Coljsq + 2) = .ColFormat(Sydz("005", GridStr(), .Cols - 1))
                    .ColWidth(Coljsq) = .ColWidth(Sydz("003", GridStr(), .Cols - 1))
                    .ColWidth(Coljsq + 1) = .ColWidth(Sydz("004", GridStr(), .Cols - 1))
                    .ColWidth(Coljsq + 2) = .ColWidth(Sydz("005", GridStr(), .Cols - 1))
                    .ColHidden(Coljsq) = .ColHidden(Sydz("003", GridStr(), .Cols - 1))
                    .ColHidden(Coljsq + 1) = .ColHidden(Sydz("004", GridStr(), .Cols - 1))
                    .ColHidden(Coljsq + 2) = .ColHidden(Sydz("005", GridStr(), .Cols - 1))
                    Coljsq = Coljsq + 3
                End If
                
                For Jsqte = 0 To 2
                    .TextMatrix(0, Coljsq + Jsqte) = Trim(Rectemp.Fields("inoutclassname") & "")
                    .ColAlignment(Coljsq + Jsqte) = 6
                    .FixedAlignment(Coljsq + Jsqte) = flexAlignCenterCenter
                    If Jsqte = 0 Then
                        .TextMatrix(1, Coljsq + Jsqte) = "数量"
                        .ColFormat(Coljsq + Jsqte) = .ColFormat(Sydz("003", GridStr(), .Cols - 1))
                        .ColWidth(Coljsq + Jsqte) = .ColWidth(Sydz("003", GridStr(), .Cols - 1))
                        .ColHidden(Coljsq + Jsqte) = .ColHidden(Sydz("003", GridStr(), .Cols - 1))
                    ElseIf Jsqte = 1 Then
                        .TextMatrix(1, Coljsq + Jsqte) = "单价"
                        .ColFormat(Coljsq + Jsqte) = .ColFormat(Sydz("004", GridStr(), .Cols - 1))
                        .ColWidth(Coljsq + Jsqte) = .ColWidth(Sydz("004", GridStr(), .Cols - 1))
                        .ColHidden(Coljsq + Jsqte) = .ColHidden(Sydz("004", GridStr(), .Cols - 1))
                    Else
                        .TextMatrix(1, Coljsq + Jsqte) = "金额"
                        .ColFormat(Coljsq + Jsqte) = .ColFormat(Sydz("005", GridStr(), .Cols - 1))
                        .ColWidth(Coljsq + Jsqte) = .ColWidth(Sydz("005", GridStr(), .Cols - 1))
                        .ColHidden(Coljsq + Jsqte) = .ColHidden(Sydz("005", GridStr(), .Cols - 1))
                    End If
                Next Jsqte
                
                InOutFlag = Rectemp.Fields("inoutflag")
                Rectemp.MoveNext
                Coljsq = Coljsq + 3
            Loop
        End With
    End If
        
End Sub


Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "cx"                                            '查 询
            Tjfx_InOutClassSumCond.Show 1
        Case "sx"                                            '刷 新
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
           Unload Me
    End Select

End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False

    '生成查询结果
    Call Sub_GridHead
    Call Sub_Query
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

End Sub

Private Sub Sub_Query()                              '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询

    Dim Rec_Query As Recordset                  '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                        '临时动态计数器
    Dim Str As String
    Dim SqlStr As String
    Dim Sqlstrfz As String
    
    
    '以下为自定义部分[
    
    With Tjfx_InOutClassSumCond
        '生成查询条件
        Str_QueryCondi = " where " & .WhCode & " and  kjyear= " & Xtyear
        For Jsqte = 0 To 3
            Select Case Jsqte
                Case 0  '月份
                    Str_QueryCondi = Str_QueryCondi & " And a.period= '" & .Com_Mon.ItemData(.Com_Mon.ListIndex) & "'"
                Case 1  '存货分类(Like)
                    If Trim(.LrText(0).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And a.invsortcode like '" & Trim(.LrText(0).Tag) & "%'"
                    End If
                Case 2  '查询存货范围(起始)
                    If Trim(.LrText(1).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And a.mnumber>='" & Trim(.LrText(1).Text) & "'"
                    End If
                Case 3  '查询存货范围(终止)
                    If Trim(.LrText(2).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And a.mnumber<= '" & Trim(.LrText(2).Text) & "'"
                    End If
            End Select
        Next Jsqte
    End With
    
    CxbbGrid.Rows = CxbbGrid.FixedRows
    
    SqlStr = "SELECT Mnumber, Mname,InOutClassName,Sum(InQuan) as InQuan,Sum(InMoney) as InMoney, " & _
            " Sum(OutQuan) as OutQuan,Sum(OutMoney) as OutMoney,InOutFlag From Chhs_v_List a " & Str_QueryCondi & _
            " and a.startflag=0 " & _
            " Group by a.Mnumber, a.Mname,a.InOutClassName, a.InOutFlag " & _
            " ORDER BY a.Mnumber "
    
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    With Rec_Query
        
        Do While Not .EOF
            '[>>自定义填充内容
            
            Str = Trim(.Fields(0) & "")
            Jsqte = CxbbGrid.FindRow(Str, , 0)
            If Jsqte <= 0 Then
                CxbbGrid.AddItem ""
                Jsqte = CxbbGrid.Rows - 1
            End If
            CxbbGrid.TextMatrix(Jsqte, 0) = Str
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields(0) & "")
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields(1) & "")
            Str = Trim(.Fields("InOutClassName") & "")
            If Str = "" And .Fields("InOutFlag") Then
                Str = "无入库类别"
                Coljsq = Sydz("003", GridStr(), Szzls)
            Else
                If Str = "" Then
                    Str = "无出库类别"
                End If
                For Coljsq = Sydz("003", GridStr(), Szzls) To CxbbGrid.Cols - 2 Step 3
                    If Trim(CxbbGrid.TextMatrix(0, Coljsq)) = Str Then
                        Exit For
                    End If
                Next Coljsq
                If Coljsq >= CxbbGrid.Cols - 1 Then Exit Sub
            End If
            If .Fields("InQuan") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Coljsq) = Val(CxbbGrid.TextMatrix(Jsqte, Coljsq)) + .Fields("InQuan")
            End If
            If .Fields("InMoney") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Coljsq + 2) = Val(CxbbGrid.TextMatrix(Jsqte, Coljsq + 2)) + .Fields("InMoney")
            End If
            If .Fields("OutQuan") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Coljsq) = Val(CxbbGrid.TextMatrix(Jsqte, Coljsq)) + .Fields("OutQuan")
            End If
            If .Fields("OutMoney") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Coljsq + 2) = Val(CxbbGrid.TextMatrix(Jsqte, Coljsq + 2)) + .Fields("OutMoney")
            End If
            If Val(CxbbGrid.TextMatrix(Jsqte, Coljsq)) <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Coljsq + 1) = Val(CxbbGrid.TextMatrix(Jsqte, Coljsq + 2)) / Val(CxbbGrid.TextMatrix(Jsqte, Coljsq))
                If Val(CxbbGrid.TextMatrix(Jsqte, Coljsq + 1)) = 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Coljsq + 1) = ""
                End If
            End If
           
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
            
             .MoveNext
        Loop
    End With
    
    '输入合计
    With CxbbGrid
        If .Rows = .FixedRows Then Exit Sub

        '纵向合计
        .SubtotalPosition = flexSTBelow
        For Jsqte = Qslz To .Cols - 1
             If Trim(.TextMatrix(.FixedRows - 1, Jsqte)) = "数量" Or Trim(.TextMatrix(.FixedRows - 1, Jsqte)) = "金额" Then
                  .Subtotal flexSTSum, -1, Jsqte, , &HF7F3EC, , , , , True
                  If Val(.TextMatrix(.Rows - 1, Jsqte)) = 0 Then
                      .TextMatrix(.Rows - 1, Jsqte) = ""
                  End If
             End If
        Next
        Jsqte = .Rows - 1
        .RowHeight(Jsqte) = Sjhgd
        .TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = ""
        .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = "合计 "
    End With
    
    ']以上为用户自定义部分
    
    Set Rec_Query = Nothing

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 = 1                                          '报 表 小 标 题 行 数
    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 = Lab_Title(0)
    Bbxbt(1) = ""
    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