VB开发的ERP系统

    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
     
    '调 入 网 格(Fixed)
    GridCode = "Chhs_AveragePrice2"
    lbl_GridCode = GridCode
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    Lbl_TitleText(0) = ""
    Lbl_TitleText(1) = ""

End Sub

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

    '卸载条件窗体
    CL_AveragePriceFind.UnloadCheck.Value = 1
    Unload CL_AveragePriceFind
    
    '卸载打印页面设置窗体
    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"                                            '查 询
            CL_AveragePriceFind.Show 1
        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
    
    '调 入 网 格
    If Not GridCode = lbl_GridCode Then
        GridCode = lbl_GridCode
        Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
          
        Qslz = GridInf(1)
        Sjhgd = GridInf(2)
        Sfxshjwg = GridInf(7)
        Szzls = CxbbGrid.Cols - 1
    End If
    
    '加快显示速度
    CxbbGrid.Redraw = False
 
    '生成查询结果
    Call Sub_Query
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

End Sub

Private Sub Sub_Query()                                     '生成查询结果(Define)
    
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Integer                        '临时动态计数器
    
    Dim Rec_Queryfz As New ADODB.Recordset
    Dim SumInQuan As Double                     '入库合计数量
    Dim SumInMoney As Double                    '入库合计金额
    Dim SumOutQuan As Double                    '发出合计数量
    Dim SumOutMoney As Double                   '发出合计金额
    Dim Avgprice As Double                      '平均单价
    Dim SqlStr As String
    Dim FindRow As Long
    
    '以下为自定义部分[
    
    With CL_AveragePriceFind
     
        '生成查询条件
        Str_QueryCondi = " WHERE KjYear='" & Xtyear & "' and Period='" & .Com_Month.ItemData(.Com_Month.ListIndex) & "' "
        
        For Jsqte = 1 To 3
            Select Case Jsqte
                Case 1  '仓库
                    Str_QueryCondi = Str_QueryCondi + " and a.WhCode='" & Trim(.LrText(0).Tag) & "'"
                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
        
    With CxbbGrid
    
        .Rows = .FixedRows
        If lbl_GridCode = "Chhs_AveragePrice2" Then    '当前月份
            SqlStr = "SELECT MNumber,MName,Model,StartQuan,StartMoney FROM Chhs_V_Mate a " + Str_QueryCondi + " ORDER BY Chhs_V_Mate.MNumber"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            
            Do While Not Rec_Query.EOF
                .AddItem ""
                Jsqte = .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
                
                .TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MNumber") & "")    '存货编码
                .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MName") & "")      '存货名称
                .TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(Rec_Query.Fields("Model") & "")      '规格型号
                If Not Rec_Query.Fields("StartQuan") = 0 Then
                    .TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Rec_Query.Fields("StartQuan")         '期初数量
                End If
                If Not Rec_Query.Fields("StartMoney") = 0 Then
                    .TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Rec_Query.Fields("StartMoney")        '期初金额
                End If
                
                Rec_Query.MoveNext
            Loop
       
       
            '收发记录表 填充出入数量、金额
            If SFjezt Then                           '系统处理实发金额字填
                SqlStr = "SELECT MNumber,MName,Model,SUM(FactReceiptQuan) AS SumInQuan, " & _
                    " SUM(Emoney) AS SumInMoney,SUM(FactIssueQuan) AS SumOutQuan, " & _
                    " SUM(IssueMoney) AS SumOutMoney FROM Chhs_V_InOut a " + Str_QueryCondi & _
                    " and (a.InOutFlag=1 or (a.InOutFlag=0 and a.IssueMoney<>0)) " & _
                    " GROUP BY MNumber,MName,Model ORDER BY MNumber"
            Else
                SqlStr = "SELECT MNumber,MName,Model,SUM(FactReceiptQuan) AS SumInQuan, " & _
                    " SUM(Emoney) AS SumInMoney,SUM(FactIssueQuan) AS SumOutQuan, " & _
                    " SUM(IssueMoney) AS SumOutMoney  FROM Chhs_V_InOut a " + Str_QueryCondi & _
                    " and a.InOutFlag=1 GROUP BY MNumber,MName, Model ORDER BY MNumber"
            End If
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            
            Do While Not Rec_Query.EOF
        
                '查询相同的物料
                FindRow = .FindRow(Trim(Rec_Query.Fields("MNumber")), .FixedRows, 0)
              
                If FindRow > 0 Then
                    Jsqte = FindRow
                Else
                    .AddItem ""
                    Jsqte = .Rows - 1
                    .RowHeight(Jsqte) = Sjhgd
                    
                    .TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MNumber") & "")   '存货编码
                    .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MName") & "")     '存货名称
                    .TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(Rec_Query.Fields("Model") & "")     '规格型号
                End If
              
                If Not Val(Rec_Query.Fields("SumInQuan")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(Rec_Query.Fields("SumInQuan"))       '本月入库数量
                End If
                If Not Val(Rec_Query.Fields("SumInMoney")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(Rec_Query.Fields("SumInMoney"))      '本月入库金额
                End If
              
                If Not Val(Rec_Query.Fields("SumOutQuan")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(Rec_Query.Fields("SumOutQuan"))      '本月出库调整数量
                End If
                If Not Val(Rec_Query.Fields("SumOutMoney")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Val(Rec_Query.Fields("SumOutMoney"))     '本月出库调整金额
                End If
                
                Rec_Query.MoveNext
            Loop
                
            
            '计算平均单价
            For Jsqte = .FixedRows To .Rows - 1
                
                SumInMoney = 0
                SumInQuan = 0
                SumOutMoney = 0
                SumOutQuan = 0
                Avgprice = 0
        
                '出入库调整单、暂估单
                If Xtclzg Then          '平均单价计算是否包括暂估
                    SqlStr = "SELECT Sum(InQuan) as SumInQuan,Sum(InMoney) as SumInMoney," & _
                             " Sum(OutQuan) as SumOutQuan,Sum(OutMoney) as SumOutMoney FROM Chhs_List a" + Str_QueryCondi & _
                             " and a.MNumber='" & Trim(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls))) & "' " & _
                             " and StartFlag=0 and BillCode in ('1301','1302','1304','1305','1306')"
                Else
                    SqlStr = "SELECT Sum(InQuan) as SumInQuan,Sum(InMoney) as SumInMoney," & _
                             " Sum(OutQuan) as SumOutQuan,Sum(OutMoney) as SumOutMoney FROM Chhs_List a" + Str_QueryCondi & _
                             " and a.MNumber='" & Trim(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls))) & "' " & _
                             " and StartFlag=0 and BillCode in ('1301','1302')"
                End If
                Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
             
                If Not Rec_Queryfz.EOF Then
                    If Not IsNull(Rec_Queryfz.Fields("SumInQuan")) Then
                        .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("SumInQuan"))         '本月入库数量
                    End If
                    If Not IsNull(Rec_Queryfz.Fields("SumInMoney")) Then
                        .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("SumInMoney"))        '本月入库金额
                    End If
                    If Not IsNull(Rec_Queryfz.Fields("SumOutQuan")) Then
                        .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("SumOutQuan"))        '本月出库调整数量
                    End If
                    If Not IsNull(Rec_Queryfz.Fields("SumOutMoney")) Then
                        .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("SumOutMoney"))       '本月出库调整金额
                    End If
                End If
                
                SumInQuan = Val(.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls))) + Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)))
                SumInMoney = Val(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) + Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)))
                SumOutQuan = Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)))
                SumOutMoney = Val(.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)))
                If Not SumInQuan - SumOutQuan = 0 Then
                    Avgprice = (SumInMoney - SumOutMoney) / (SumInQuan - SumOutQuan)
                End If
                
                If Not Avgprice = 0 Then
                    .TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Avgprice
                End If
                If SumInQuan = 0 Then
                    .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = ""
                End If
                If SumInMoney = 0 Then
                    .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = ""
                End If
                If SumOutQuan = 0 Then
                    .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = ""
                End If
                If SumOutMoney = 0 Then
                    .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = ""
                End If
             
            Next Jsqte
    
        Else                        '以前月份和期末处理完毕,在总帐视图中取数据（以前在总帐中取数据）
    
            SqlStr = "SELECT MNumber,MName,StartMoney,InMoney,OutMoney,OutPrice FROM Chhs_V_Mate a" + Str_QueryCondi + "AND OutPrice<>0 ORDER BY Chhs_V_Mate.MNumber"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            
            Do While Not Rec_Query.EOF
                .AddItem ""
                Jsqte = .Rows - 1
                .TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MNumber") & "")
                .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Rec_Query.Fields("MName"))
                .TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Val(Rec_Query.Fields("StartMoney")) + Val(Rec_Query.Fields("InMoney")) - Val(Rec_Query.Fields("OutMoney"))
                .TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Val(Rec_Query.Fields("OutPrice"))
                .RowHeight(Jsqte) = Sjhgd
                Rec_Query.MoveNext
            Loop
        End If
        
    End With
    
    Set Rec_Query = Nothing
    Set Rec_Queryfz = 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 = ReportTitle
    Bbxbt(1) = Fun_FormatOutPut("月份:" + Lbl_TitleText(0), 30)
    Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("仓库:" + Lbl_TitleText(1), 30)
    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