VB开发的ERP系统

    Unload CL_DiscrepancyFind
    
    '卸载打印页面设置窗体
    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_DiscrepancyFind.Show 1
        Case "Bill"                                          '单 据
            Call CxbbGrid_DblClick
        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 lbl_GridCode = "Chhs_Discrepancy2" Then
        SzToolbar.Buttons("Bill").Enabled = False
    Else
        SzToolbar.Buttons("Bill").Enabled = True
    End If
    
    '调 入 网 格
    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 SumDiff As Double                             '合计差异
    Dim SumPlanMonery As Double                       '合计计划金额
    Dim DiffLv As Double                              '差异率
    Dim SqlStr As String
    Dim FindRow As Long
    
    '以下为自定义部分[
    
    With CL_DiscrepancyFind
     
        '生成查询条件
        Str_QueryCondi = " WHERE KjYear='" & Xtyear & "' and Period='" & .Com_Month.ItemData(.Com_Month.ListIndex) & "' "
        
        For Jsqte = 1 To 3
            Select Case Jsqte
                Case 1  '仓库
                    If Not Trim(.LrText(0)) = "" Then
                        Str_QueryCondi = Str_QueryCondi + " and a.WhCode='" & 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

    
    With CxbbGrid
        SumPlanMonery = 0
        SumDiff = 0
        DiffLv = 0
        
        .Rows = .FixedRows
        
        If lbl_GridCode = "Chhs_Discrepancy2" Then
            SqlStr = "select MNumber,MName,Model,StartDiff,StartMoney from Chhs_V_Mate a " & Str_QueryCondi & " order by a.MNumber"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)

            Do While Not Rec_Query.EOF
            
                .AddItem ""
                Jsqte = .Rows - 1
                '设置数据行高度(Fixed)
                CxbbGrid.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("StartDiff") = 0 Then
                    .TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Rec_Query.Fields("StartDiff")         '期初差异
                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
            
            '收发记录表
            SqlStr = "SELECT MNumber, MName, Model, (SUM(EMoney)- SUM(PlanMoney)) AS SumDiff,  " & _
                     "SUM(PlanMoney) AS SumPlanMonery From Chhs_V_InOut a " & Str_QueryCondi & _
                     " and InOutFlag=1 GROUP BY  MNumber, MName, Model"
            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
                    '设置数据行高度(Fixed)
                    CxbbGrid.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("Sumdiff")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Rec_Query.Fields("Sumdiff")                '入库差异
                End If
                If Not Val(Rec_Query.Fields("SumPlanMonery")) = 0 Then
                    .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Rec_Query.Fields("SumPlanMonery")          '入库计划金额
                End If
              
                Rec_Query.MoveNext
                
            Loop
           
            '计算差异率
            SumPlanMonery = 0
            SumDiff = 0
            DiffLv = 0
            
            For Jsqte = .FixedRows To .Rows - 1
            
                '差异率计算包括出入库调整单、计划价调整单，实发金额自填不处理
                SqlStr = "SELECT BillCode,InMoney,OutMoney,JfDiff,DfDiff FROM Chhs_List a " & Str_QueryCondi & " and a.MNumber='" & Trim(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls))) & "' " & _
                         "and BillCode in ('1301','1302','1303') "
                Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                
                Do While Not Rec_Queryfz.EOF
                    If Trim(Rec_Queryfz.Fields("BillCode")) = "1302" Then
                        .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("DfDiff"))                                                    '出库调整差异
                    Else
                        .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("JfDiff")) - Val(Rec_Queryfz.Fields("DfDiff"))                '入库差异
                        .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("InMoney")) - Val(Rec_Queryfz.Fields("OutMoney"))             '入库金额
                    End If
                    Rec_Queryfz.MoveNext
                Loop
    
                '差异率计算是否包括本期暂估
                If Cylzg Then
        
                    '暂估单为收入单据
                    SqlStr = "SELECT BillCode,JfDiff,DfDiff,InMoney FROM Chhs_List a " & Str_QueryCondi & _
                             " and MNumber='" & Trim(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls))) & "' " & _
                             " and BillCode in('1304','1305','1306') "
                    Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    
                    Do While Not Rec_Queryfz.EOF
                        .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("JfDiff")) - Val(Rec_Queryfz.Fields("DfDiff"))                 '入库差异
                        .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) + Val(Rec_Queryfz.Fields("InMoney"))                                                    '入库金额
                        Rec_Queryfz.MoveNext
                    Loop
                
                End If
                
                If Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls))) = 0 Then
                    .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = ""
                End If
                If Val(.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls))) = 0 Then
                    .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = ""
                End If
                
                '计算差异率
                SumDiff = Val(.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls))) + Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) - Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)))
                SumPlanMonery = Val(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) + Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) - Val(.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)))
                
                If Not SumPlanMonery = 0 Then
                    DiffLv = Format(SumDiff / SumPlanMonery, "#########0.######")
                End If
             
                '显示差异率
                If Not DiffLv = 0 Then
                    .TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = DiffLv
                    DiffLv = 0
                End If
             
            Next Jsqte
            
        Else  '以前月份和期末处理完毕
            
            SqlStr = "SELECT * From Chhs_V_Mate a " & Str_QueryCondi & " order by a.MNumber"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)

            Do While Not Rec_Query.EOF
            
                 If Not Val(Rec_Query.Fields("StartDiff")) + Val(Rec_Query.Fields("JfDiff")) - Val(Rec_Query.Fields("DfDiff")) = 0 Then
                    .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)) = Val(Rec_Query.Fields("StartDiff")) + Val(Rec_Query.Fields("JfDiff")) - Val(Rec_Query.Fields("DfDiff"))
                    If Val(.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls))) = 0 Then
                        .TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = ""
                    End If
                    .TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Val(Rec_Query.Fields("StartMoney")) + Val(Rec_Query.Fields("InMoney")) - Val(Rec_Query.Fields("OutMoney"))
                    If Val(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) = 0 Then
                        .TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = ""
                    End If
                    SqlStr = "SELECT * FROM chhs_DiffBill a " & Str_QueryCondi & " and a.MNumber='" & Trim(Rec_Query.Fields("MNumber")) & "'"
                    Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    
                    If Not Rec_Queryfz.EOF Then
                        .TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Rec_Queryfz.Fields("DiffLv"))
                    End If
                End If
                Rec_Query.MoveNext
            Loop
        End If
    End With
    
    Set Rec_Query = Nothing
    Set Rec_Queryfz = Nothing
    ']以上为用户自定义部分

End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim Rectemp As New ADODB.Recordset               '临时使用动态集
    Dim Yesno As Integer
    
    '非数据行退出
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then
        Exit Sub
    End If
    
    If Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    '当前月份未记帐不显示单据
    If SzToolbar.Buttons("Bill").Enabled = False Then
        Exit Sub
    End If
    
    CL_DiscrepancyChange.lbl_Tstext(0) = Lbl_TitleText(0)
    CL_DiscrepancyChange.lbl_Tstext(0).Tag = Lbl_TitleText(0).Tag
    
    CL_DiscrepancyChange.Query_Cond = " Chhs_V_DiffBill.WhCode='" & Lbl_TitleText(1).Tag & "'"
    CL_DiscrepancyChange.Show 1

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