-

VB开发的ERP系统

    On Error Resume Next
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140

End Sub

Private Sub Form_Load()                                                   '窗体装入
  
    '调入打印页面设置窗体
    ReportTitle = "存货ABC分类表"
    XtReportCode = "Chhs_AbcFl"
    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_ABCFl"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
        
    '清除表头内容
    Lbl_TitleText(0) = ""

End Sub

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

    FlCond = ""

    '卸载条件窗体
    Tjfx_AbcFxCond.UnloadCheck.Value = 1
    Unload Tjfx_AbcFxCond
    
    '卸载打印页面设置窗体
    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)
    End Select

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_AbcFxCond.Show 1
        Case "a"                                             'A  类
            Call Sub_A
        Case "b"                                             'B  类
            Call Sub_B
        Case "c"                                             'C  类
            Call Sub_C
        Case "zh"                                            '综 合
            Call Sub_Zh
        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_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 Recordset                  '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                        '临时动态计数器
    Dim Str1 As String
    Dim SumQuan As Double
    Dim SumMoney As Double
    
    
    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With Tjfx_AbcFxCond
         
            '生成查询条件
            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
    Else
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2"
        End If
    End If
    
    CxbbGrid.Rows = CxbbGrid.FixedRows
     
    '结存总金额、总数量
    SqlStr = "SELECT  SUM(StartQuan + InQuan - OutQuan) AS Quan," & _
             " SUM(StartMoney + InMoney - OutMoney) AS Money " & _
             " From Chhs_v_Mate a " & Str_QueryCondi & FlCond
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not Rec_Query.EOF Then
        If Not IsNull(Rec_Query.Fields("quan")) Then
            SumQuan = Rec_Query.Fields("quan")
        Else
            SumQuan = 0
        End If
        If Not IsNull(Rec_Query.Fields("money")) Then
            SumMoney = Rec_Query.Fields("money")
        Else
            SumMoney = 0
        End If
    Else
        Exit Sub
    End If
    SqlStr = "SELECT MNumber, MName, Model, SUM(StartQuan + InQuan - OutQuan) AS Quan," & _
             " SUM(StartMoney + InMoney - OutMoney) AS Money, AbcSort" & _
             " From Chhs_v_Mate a " & Str_QueryCondi & FlCond & " GROUP BY MNumber, MName, Model, AbcSort" & _
             " ORDER BY AbcSort, MNumber "
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    With Rec_Query
        
        Do While Not .EOF
    
            CxbbGrid.AddItem ""
            Jsqte = CxbbGrid.Rows - 1
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("abcsort") & "")
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("mnumber") & "")
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("mname") & "")
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("model") & "")
            If .Fields("quan") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = .Fields("quan") + 0
            End If
            If SumQuan <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = .Fields("quan") * 100 / SumQuan
            End If
            If .Fields("money") <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("money") + 0
            End If
            If SumMoney <> 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("money") * 100 / SumMoney
            End If
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    
    '输入合计
    With CxbbGrid
        If .Rows = .FixedRows Then Exit Sub
        
        .SubtotalPosition = flexSTBelow
        For Jsqte = Qslz To .Cols - 1
             If GridBoolean(Jsqte, 4) Then
                  .Subtotal flexSTSum, -1, Jsqte, , &HF7F3EC, , , , , True
             End If
        Next
        Jsqte = .Rows - 1
        .RowHeight(Jsqte) = Sjhgd
        .TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = ""
        .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = "合计 "
           
        For Coljsq = Qslz To .Cols - 1
            If Val(.TextMatrix(Jsqte, Coljsq)) = 0 And GridBoolean(Coljsq, 4) Then
                .TextMatrix(Jsqte, Coljsq) = ""
            End If
        Next
    End With
    
    ']以上为用户自定义部分
    
    Set Rec_Query = Nothing

End Sub

Private Sub Sub_A()                 'A类
    FlCond = " and a.abcsort='A'"
    
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
    Call Sub_Query(1)
    FlCond = ""
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
End Sub

Private Sub Sub_B()                 'B类
    FlCond = " and a.abcsort='B'"
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
    Call Sub_Query(1)
    FlCond = ""
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
End Sub

Private Sub Sub_C()                 'C类
    FlCond = " and a.abcsort='C'"
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
    Call Sub_Query(1)
    FlCond = ""
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
End Sub

Private Sub Sub_Zh()                'Zh类
    FlCond = ""
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
    Call Sub_Query(1)
    FlCond = ""
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
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) = Fun_FormatOutPut("月份:" + Trim(Lbl_TitleText(0)), 50)
    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