VB开发的ERP系统

    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 1 Then
        '1.判断当前销售订单是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
        
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete XS_OrderBillMain Where OrderBillMainId=" & Lng_BillID)        '删除单据主表内容
        Cw_DataEnvi.DataConnect.Execute ("Delete XS_OrderBillSub Where OrderBillMainId=" & Lng_BillID)         '删除单据子表内容
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '删除网格中单据数据
        Jsqte = CxbbGrid.FixedRows
        Do While Jsqte <= CxbbGrid.Rows - 1
            If Val(CxbbGrid.TextMatrix(Jsqte, 0)) = Lng_BillID Then
                CxbbGrid.RemoveItem (CxbbGrid.Row)
            Else
                Jsqte = Jsqte + 1
            End If
        Loop
    Else
        Exit Sub
    End If
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除销售订单过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
    
    Dim Rectemp As New ADODB.Recordset     '临时使用动态集
    Dim SqlStr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
    
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    SqlStr = "Select Checker From XS_OrderBillMain Where OrderBillMainId=" & Lng_BillID
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    With Rectemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该销售订单已审核确认,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowDelete = True
    
End Function

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) = ""
    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

Private Sub Sub_OperStatus(Str_Status As String)
    
    Select Case Str_Status
        Case "0"
            SzToolbar.Buttons("qx").Enabled = True
            SzToolbar.Buttons("qxi").Enabled = True
            SzToolbar.Buttons("shc").Enabled = True
            SzToolbar.Buttons("hc").Enabled = True
            SzToolbar.Buttons("xg").Enabled = False
            SzToolbar.Buttons("sc").Enabled = False
            SzToolbar.Buttons("pz").Enabled = False
        
        Case "1"
            SzToolbar.Buttons("xg").Enabled = True
            SzToolbar.Buttons("sc").Enabled = True
            SzToolbar.Buttons("pz").Enabled = True
            SzToolbar.Buttons("qx").Enabled = False
            SzToolbar.Buttons("qxi").Enabled = False
            SzToolbar.Buttons("shc").Enabled = False
            SzToolbar.Buttons("hc").Enabled = False
            
    End Select
    
End Sub

Private Sub ShowBill()

    Dim Rectemp As New ADODB.Recordset
    Dim Load_Form As Form
    Dim BillCode As String
    Dim SqlStr As String
    
    If Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 8)) = "" Then
        Tsxx = "此单据已被其他用户删除!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If

    BillCode = Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 6))
    
    If BillCode = "1301" Or BillCode = "1302" Then
        SqlStr = "SELECT InOutAdjustMainId From Chhs_InOutAdjustMain Where InOutAdjustMainId=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 9)) + 0
    ElseIf BillCode = "1303" Then
        SqlStr = "SELECT PlanAdjustMainId From Chhs_PlanAdjustMain Where PlanAdjustMainId=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 9)) + 0
    ElseIf BillCode = "1307" Then
        SqlStr = "SELECT DiffBillId From Chhs_DiffBill Where whcode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 3)) & "'AND Chhs_DiffBill.KjYear=" & PGKjYear & ""
    Else
        SqlStr = "SELECT InOutMainId From Gy_InOutMain Where InOutMainId=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 8)) + 0
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Rectemp.EOF Then
        Tsxx = "此单据已被其他用户删除!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
        

    '根据单据类型和主表ID号显示单据
    Select Case BillCode
        
        Case "1212"      '材料入库单
            Set Load_Form = DJ_MateInBill
            
        Case "1202"      '产品入库单
            Set Load_Form = DJ_ProdInBill
          
        Case "1203"      '其它入库单
            Set Load_Form = DJ_OtherInBill
            
        Case "1204"      '材料出库单
            Set Load_Form = DJ_MateOutBill
        
        Case "1205"      '销售出库单
            Set Load_Form = DJ_SellOutBill
          
        Case "1206"      '其它出库单
            Set Load_Form = DJ_OtherOutBill
        
        Case "1301"      '入库单调整
            Set Load_Form = DJ_AdjustInbill
          
        Case "1302"      '出库单调整
            Set Load_Form = DJ_AdjustOutBill
            
        Case "1303"      '计划调整单
            Set Load_Form = DJ_AdjustPlan
            
        Case "1304"      '蓝字暂估单
            Set Load_Form = Eval_BlueBill
            Xtcdcsfz = "StartFlag=0 and Kjyear='" & PGKjYear & "' and Period='" & PGNowmon & "' "
            
        Case "1305"      '红字回冲单
            Set Load_Form = Eval_RedBill
            Xtcdcsfz = "StartFlag=0 and Kjyear='" & PGKjYear & "' and Period='" & PGNowmon & "' "
        
        Case "1307"      '差异结转单
            
            Set Load_Form = CL_DiscrepancyChange
            
        Case Else
            Exit Sub
    End Select
    
    Xtcdcs = "3"
    Select Case BillCode
        Case "1301", "1302", "1303"
            XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 9)
            Xtcdcsfz = XT_BillID
        Case "1307"
            CL_DiscrepancyChange.lbl_Tstext(0) = CStr(PGKjYear) + "." + Str(PGNowmon)
            CL_DiscrepancyChange.lbl_Tstext(0).Tag = PGNowmon
            CL_DiscrepancyChange.Query_Cond = "Chhs_v_DiffBill.whcode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 3)) & "' AND Chhs_v_DiffBill.KjYear=" & PGKjYear
        Case Else
            XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 8)
    End Select
    
    Load_Form.Show 1
    Set Load_Form = Nothing

End Sub

'生成凭证前进行判断
Private Sub MakePz()

    Dim count As Integer

    For count = CxbbGrid.FixedRows To CxbbGrid.Rows - CxbbGrid.FixedRows
        If CxbbGrid.TextMatrix(count, Sydz("001", GridStr(), Szzls)) Then
            If InStr(1, "1301,1302,1303,1304,1305", CxbbGrid.TextMatrix(count, 6)) = 0 And Val(CxbbGrid.TextMatrix(count, 8)) = 0 Then
                Tsxx = "单据号为:" & CxbbGrid.TextMatrix(count, Sydz("002", GridStr(), Szzls)) & "  仓库为:" & CxbbGrid.TextMatrix(count, Sydz("005", GridStr(), Szzls)) & ",在收发记录中不存在"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            End If
            If Trim(MListId) = "" Then
                Select Case CxbbGrid.TextMatrix(count, 6)
                    Case "1301", "1302", "1303"
                        MListId = MListId + "InoutAdjustMainId= " & CxbbGrid.TextMatrix(count, 9) & ""
                    Case "1307"
                        MListId = MListId + "ListId= " & CxbbGrid.TextMatrix(count, 8) & ""
                    Case Else
                        MListId = MListId + "InoutMainId= " & CxbbGrid.TextMatrix(count, 8) & ""
                End Select
            Else
                Select Case CxbbGrid.TextMatrix(count, 6)
                    Case "1301", "1302", "1303"
                        MListId = MListId + " or InoutAdjustMainId= " & CxbbGrid.TextMatrix(count, 9) & ""
                    Case "1307"
                        MListId = MListId + " or ListId= " & CxbbGrid.TextMatrix(count, 8) & ""
                    Case Else
                        MListId = MListId + " or InoutMainId= " & CxbbGrid.TextMatrix(count, 8) & ""
                End Select
            End If
        End If
    Next
    
    MListId = "(" & MListId & ")"
    
    If Trim(MListId) <> "()" Then
        CL_MakeVoucherSub.Show 1
    Else
        Tsxx = "请先选择要生成凭证的单据"
        Call Xtxxts(Tsxx, 0, 4)
    End If

End Sub

'删除凭证
Private Sub Sub_DelVouch()
    
    Dim VouchId As Long
    Dim ListId As Long
    Dim Jsqte As Long
    Dim yhAnswer As Integer
    
    '不能删除凭证的条件
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then
        Exit Sub
    End If
    
    '删除凭证
    
    VouchId = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 10))
    
    Tsxx = "请确认是否删除当前单据?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    If yhAnswer = 1 Then
       
        Cw_DataEnvi.DataConnect.BeginTrans
       
        '删除单据内容
        Cw_DataEnvi.DataConnect.Execute ("DELETE chhs_VouchSub WHERE VouchId=" & VouchId & "")
        Cw_DataEnvi.DataConnect.Execute ("DELETE Chhs_VouchMain WHERE VouchId=" & VouchId & "")
        
       
        '删除网格行
        Do While Jsqte <= CxbbGrid.Rows - CxbbGrid.FixedRows
            If Val(CxbbGrid.TextMatrix(Jsqte, 10)) = VouchId Then
                ListId = Val(CxbbGrid.TextMatrix(Jsqte, 1))
                Cw_DataEnvi.DataConnect.Execute ("UPDATE Chhs_list SET Vouchid=0 WHERE ListID=" & ListId & "")
                CxbbGrid.RemoveItem (Jsqte)
            Else
                  Jsqte = Jsqte + 1
            End If
        Loop
              
       Tsxx = "删除完毕!"
       Call Xtxxts(Tsxx, 0, 4)
              
       Cw_DataEnvi.DataConnect.CommitTrans
              
   End If
    
    
End Sub

Public Property Get ListId() As Variant
    ListId = MListId
End Property

Public Property Get PzType() As Integer
    PzType = MPzType
End Property