VB开发的ERP系统

            
        Case "qxi"                                           '全消
            For count = CxbbGrid.FixedRows To CxbbGrid.Rows - CxbbGrid.FixedRows
                CxbbGrid.TextMatrix(count, Sydz("001", GridStr(), Szzls)) = 0
            Next
            
        Case "dj"                                             '显示单据
        
            If CxbbGrid.Rows <> CxbbGrid.FixedRows Then
                Call ShowBill
            End If
            
        Case "sc"
            Call Sub_DelVouch
        Case "xg"
            If CxbbGrid.Rows = CxbbGrid.FixedRows Then
                Exit Sub
            End If
            CL_PzFrm.Timer1.Enabled = True
            CL_PzFrm.lbl_Tag = "3"
            CL_PzFrm.Lab_VouchId = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 10))
            CL_PzFrm.Show 1
        Case "pz"
            If CxbbGrid.Rows = CxbbGrid.FixedRows Then
                Exit Sub
            End If
            
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("Select vouchid from chhs_list where VouchId=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 10)) & "")
            If Rectemp.EOF Then
                Tsxx = "此凭证已被其他用户删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            End If
            
            CL_PzFrm.Timer1.Enabled = True
            CL_PzFrm.lbl_Tag = "2"
            CL_PzFrm.Lab_VouchId = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 10))
            CL_PzFrm.Show 1
            
        Case "cx"                                             '查询
            CL_MakeVoucherFind.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
    
    '加快显示速度
    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 Str_QueryCondi As String                '用户录入查询条件
    Dim SqlStr As String                        '查询字符串
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Integer                        '临时动态计数器
    Dim VouchNoValue As String                  '记录上一张凭证标识
    Dim count As Integer
    Dim billtype_flag As Boolean
    
    Dim BillNumValue As String
    Dim WhNameValue As String
    Dim BillNameValue As String
 
    '以下为用户自定义部分[

    With CL_MakeVoucherFind
        
        If CL_MakeVoucherFind.Opti_bill1.Value Then
            Str_QueryCondi = "SELECT * FROM Chhs_V_List LEFT OUTER JOIN Gy_Whlimit ON Chhs_V_List.WhCode = Gy_Whlimit.WhCode WHERE Gy_Whlimit.Czybm='" & Xtczybm & "' AND Vouchid=0 AND KjYear='" & PGKjYear & "' AND Period='" & PGNowmon & "' AND StartFlag<>1 "
            CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = False
            Call Sub_OperStatus("0")
        Else
            If CL_MakeVoucherFind.Opti_bill2.Value Then
                Str_QueryCondi = "SELECT * FROM Chhs_V_List LEFT OUTER JOIN Gy_Whlimit ON Chhs_V_List.WhCode = Gy_Whlimit.WhCode WHERE Gy_Whlimit.Czybm='" & Xtczybm & "' AND Vouchid<>0 AND KjYear='" & PGKjYear & "' AND Period='" & PGNowmon & "'"
                CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = True
                Call Sub_OperStatus("1")
            End If
        End If
        
        For Jsqte = 1 To 8
            
            Select Case Jsqte
                
                Case 1    '仓库
                    If Trim(.LrText(0).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " AND Chhs_V_List.WhCode='" & Trim(.LrText(0).Tag) & "'"
                    End If
                    
                Case 2    '存货分类
                    If Trim(.LrText(1).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " AND InvSortcode like '" & Trim(.LrText(1).Tag) & "%'"
                    End If
                    
                Case 3    '存货编码
                    If Trim(.LrText(2).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " AND MNumber ='" & Trim(.LrText(2).Text) & "'"
                    End If
                    
                Case 4    '日期
                    If Trim(.LrText(3).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And Chhs_V_List.BillDate>=' " & Trim(.LrText(3).Text) & "'"
                    End If
                Case 5    '日期
                    If Trim(.LrText(4).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And Chhs_V_List.BillDate<=' " & Trim(.LrText(4).Text) & "'"
                    End If
                    
                Case 6    '部门
                    If Trim(.LrText(5).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " AND DeptCode='" & Trim(.LrText(5).Tag) & "'"
                    End If
                    
                Case 7   '记帐人
                    If Trim(.LrText(6).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " AND ChalkitupMan='" & Trim(.LrText(6).Text) & "'"
                    End If
                
                Case 8
                    Str_QueryCondi = Str_QueryCondi + CL_MakeVoucherFind.SqlStr
                    
            End Select
            
        Next Jsqte
        
        Str_QueryCondi = Str_QueryCondi + " ORDER BY BiLLCode+Chhs_V_List.WhCode+BillNum"
        
    End With

    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Str_QueryCondi)
    
    With Rec_Query
    
        CxbbGrid.Rows = CxbbGrid.FixedRows
        Jsqte = CxbbGrid.FixedRows
        
        Do While Not .EOF
        
            If CL_MakeVoucherFind.Opti_bill1.Value Then
            
                BillNumValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("002", GridStr(), Szzls)))
                WhNameValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("005", GridStr(), Szzls)))
                BillNameValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("009", GridStr(), Szzls)))
                
                If Not (BillNumValue = Trim(.Fields("BillNum")) And WhNameValue = Trim(.Fields("WhName")) And BillNameValue = Trim(.Fields("BillName"))) Then
                    
                    If Jsqte >= CxbbGrid.Rows Then
                        CxbbGrid.AddItem ""
                    End If
                 
                    CxbbGrid.TextMatrix(Jsqte, 1) = Val(.Fields("ListID"))                  '单据ID
                    CxbbGrid.TextMatrix(Jsqte, 2) = Val(.Fields("InoutSubId"))              '收发记录子表ID
                    CxbbGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("WhCode"))                 '仓库编码
                    CxbbGrid.TextMatrix(Jsqte, 4) = Val(.Fields("InoutAdjustSubId"))        '调整单子表ID
    '                CxbbGrid.TextMatrix(Jsqte, 5) = Val(.Fields("receipt_id"))             '材料入库单子表ID
                    CxbbGrid.TextMatrix(Jsqte, 6) = Trim(.Fields("BillCode"))               '单据类型
                    CxbbGrid.TextMatrix(Jsqte, 7) = Trim(.Fields("InoutFlag"))              '收发标志
                    If Trim(.Fields("BillCode")) = "1307" Then
                        CxbbGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("ListId") & "")        '明细帐ID
                    Else
                        CxbbGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("InoutMainId") & "")   '收发记录主表ID
                    End If
                    CxbbGrid.TextMatrix(Jsqte, 9) = Val(.Fields("InoutAdjustMainId"))       '调整单主表ID
                    CxbbGrid.TextMatrix(Jsqte, 10) = Val(.Fields("vouchId"))                '凭证ID
                        
                    '如果为同一张凭证则不再输出制单日期和凭证号
                    
                    CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = 0                                     '选择
                    CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = .Fields("BillNum")                    '单据号
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Format(Trim(.Fields("ChalkDate") & ""), "yyyy-mm-dd")       '记帐日期
                    CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Format(Trim(.Fields("BillDate") & ""), "yyyy-mm-dd")        '单据日期
                    CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")          '仓库
                    CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ChalkitupMan") & "")    '记帐人
                    CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("InOutClassName") & "")  '收发类别
                    If .Fields("vouchId") <> 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Mid(Trim(Str(10000 + .Fields("vouchNO"))), 2, 4)                '凭证号
                    End If
                    CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("BillName"))             '单据类型
                    
                    CxbbGrid.RowHeight(Jsqte) = Sjhgd
                    Jsqte = Jsqte + 1
                End If
            Else
                BillNumValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("002", GridStr(), Szzls)))
                VouchNoValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("008", GridStr(), Szzls)))
                BillNameValue = Trim(CxbbGrid.TextMatrix(Jsqte - 1, Sydz("009", GridStr(), Szzls)))
                
                If Not (BillNumValue = Trim(.Fields("BillNum")) And Val(VouchNoValue) = Trim(.Fields("vouchNO")) And BillNameValue = Trim(.Fields("BillName"))) Then
                    If Jsqte >= CxbbGrid.Rows Then
                        CxbbGrid.AddItem ""
                    End If
                 
                    CxbbGrid.TextMatrix(Jsqte, 1) = Val(.Fields("ListID"))                  '单据ID
                    CxbbGrid.TextMatrix(Jsqte, 2) = Val(.Fields("InoutSubId"))              '收发记录子表ID
                    CxbbGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("WhCode"))                 '仓库编码
                    CxbbGrid.TextMatrix(Jsqte, 4) = Val(.Fields("InoutAdjustSubId"))        '调整单子表ID
    '                CxbbGrid.TextMatrix(Jsqte, 5) = Val(.Fields("receipt_id"))             '材料入库单子表ID
                    CxbbGrid.TextMatrix(Jsqte, 6) = Trim(.Fields("BillCode"))               '单据类型
                    CxbbGrid.TextMatrix(Jsqte, 7) = Trim(.Fields("InoutFlag"))              '收发标志
                    If Trim(.Fields("BillCode")) = "1307" Then
                        CxbbGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("ListId") & "")        '明细帐ID
                    Else
                        CxbbGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("InoutMainId") & "")   '收发记录主表ID
                    End If
                    CxbbGrid.TextMatrix(Jsqte, 9) = Val(.Fields("InoutAdjustMainId"))       '调整单主表ID
                    CxbbGrid.TextMatrix(Jsqte, 10) = Val(.Fields("vouchId"))                '凭证ID
                        
                    '如果为同一张凭证则不再输出制单日期和凭证号
                    
                    CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = 0                                     '选择
                    CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = .Fields("BillNum")                    '单据号
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Format(Trim(.Fields("ChalkDate") & ""), "yyyy-mm-dd")       '记帐日期
                    CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Format(Trim(.Fields("BillDate") & ""), "yyyy-mm-dd")        '单据日期
                    CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")          '仓库
                    CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ChalkitupMan") & "")    '记帐人
                    CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("InOutClassName") & "")  '收发类别
                    If .Fields("vouchId") <> 0 And Not IsNull(.Fields("vouchNO")) Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Mid(Trim(Str(10000 + .Fields("vouchNO"))), 2, 4)                '凭证号
                    End If
                    CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("BillName"))             '单据类型
                    
                    CxbbGrid.RowHeight(Jsqte) = Sjhgd
                    Jsqte = Jsqte + 1
                    
                End If
            End If
            
            .MoveNext
            
        Loop
        
    End With
    
    ']以上为用户自定义部分
    
End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Then
        Exit Sub
    End If
    If CL_MakeVoucherFind.Opti_bill1 Then
        If CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) Then
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = 0
        Else
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = 1
        End If
    End If
    
End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With MS_FrmDjsDdlr
        
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
        
        .Show 1
    End With
    
    If Xtfhcs = "1" Then
        Tsxx = "销售订单发生变化,是否刷新销售订单列表?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        If yhAnswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
            
            '加快显示速度
            CxbbGrid.Redraw = False
            
            '生成查询结果
            Call Sub_Query
            
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
    
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前销售订单
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    Tsxx = "请确认是否删除当前销售订单?"