VB开发的ERP系统

        Call xswbk
        
        '函数返回False
        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    Dim Jsqte As Long                             '临时计数器
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
     End If
    
    '设置操作状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
    
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
    
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
    
    TextChangeLock = True
    '录入文本框清除内容
    For Jsqte = Max_Text_Index To 0 Step -1
        LrText(Jsqte).Tag = ""
        LrText(Jsqte).Text = ""
    Next Jsqte
    '清除CMB内容
    If Cmb_LineName.ListCount > 1 Then
        Cmb_LineName.Text = Cmb_LineName.List(1)
        Cmb_LineCode.Text = Cmb_LineCode.List(1)
    End If
    Cmb_SiteName.Clear
    Cmb_SiteCode.Clear
    Cmb_BanZu.Text = Cmb_BanZu.List(1)
    Cmb_SiteTime.Text = Cmb_SiteTime.List(1)
    Cmb_MNumber.Clear
    Cmb_MName.Clear
    
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(1).Text = Xtczy
    LrText(2).Text = ""
     '读取最新的单据编码
    LrText(8).Text = CreatBillCode(BillCode, False)
    
    '设置取样日期默认为系统业务日期
    LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
    TextChangeLock = False
    
    '<<]
    
    '重置网格(Fixed)
    With WglrGrid
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
        For Jsqte = .FixedRows To .Rows - 1
            .RowHeight(Jsqte) = Sjhgd
        Next Jsqte
        WglrGrid.Clear 1
        Changelock = True
        .Select .FixedRows, Qslz
        Changelock = False
    End With
    
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    Cmb_LineName.SetFocus
    
End Sub

Private Sub Sub_EditBill()                 '修改一张单据
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
     End If
    
    '非有效单据不予进行修改动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
    
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
    
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
    
    '设置工具条状态
    Call Sub_OperStatus("30")
    
    '显示制单人
    LrText(1).Text = Xtczy
    
End Sub

Private Sub Sub_DeleteBill()             '删除当前单据
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim Jsqte As Long                    '临时使用计数器
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
     End If
    
    '非有效单据不予进行删除动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
    
    Tsxx = "请确认是否删除当前单据?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
    
    If YAnswer = 1 Then
        
        '判断当前单据是否允许删除
        If Not Fun_AllowEdit Then
            Exit Sub
        End If
        
        '进行事务处理
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        
        '1.删除单据所有内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Qc_MidCheckSub Where MidCheckMainID=" & Val(Lab_BillId.Caption))
        Cw_DataEnvi.DataConnect.Execute ("Delete Qc_MidCheckMain Where MidCheckMainID=" & Val(Lab_BillId.Caption))
        
        
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '标识单据发生改动
        Bln_BillChange = True
        
        '单据ID置0
        Lab_BillId.Caption = 0
    Else
        Exit Sub
    End If
    
    '删除单据后重置状态
    
    '1.显示下一张单据
    Call Sub_Next
    
    '2.如果无下一张单据则搜索上一张单据
    If Val(Lab_BillId.Caption) = 0 Then
        Call Sub_Prev
    End If
    
    '3.如无单据则置单据为空状态
    If Val(Lab_BillId.Caption) = 0 Then
        '清除录入文本框
        For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Tag = ""
            LrText(Jsqte).Text = ""
        Next Jsqte
        '清除CMB内容
        Cmb_LineName.Text = Cmb_LineName.List(0)
        Cmb_LineCode.Text = Cmb_LineCode.List(0)
        Cmb_SiteName.Clear
        Cmb_SiteCode.Clear
        Cmb_BanZu.Text = Cmb_BanZu.List(0)
        Cmb_SiteTime.Text = Cmb_SiteTime.List(0)
        Cmb_MNumber.Clear
        Cmb_MName.Clear
        '重置网格(Fixed)
        With WglrGrid
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With
        
        
        
        '设置操作状态为浏览
        Lab_OperStatus = "1"
        Call Sub_OperStatus("10")
    End If
    
    Rec_Query.Requery
    Rec_Query.Find "MidCheckMainID=" & Val(Lab_BillId.Caption)
    Exit Sub
    
Swcwcl:          '单据删除时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
    
    Dim Jsqte As Long                    '临时使用计数器
    
    '先关闭录入载体(Fixed)
    Changelock = True
    Valilock = True
    Call Ycwbk
    Changelock = False
    Valilock = False
    
    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("MidCheckMainID")
        Call Sub_ShowBill
    Else
        '单据ID置为0
        Lab_BillId.Caption = 0
        
        '清除录入文本框
        For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Tag = ""
            LrText(Jsqte).Text = ""
        Next Jsqte
        '清除CMB内容
        Cmb_LineName.Text = Cmb_LineName.List(0)
        Cmb_LineCode.Text = Cmb_LineCode.List(0)
        Cmb_SiteName.Clear
        Cmb_SiteCode.Clear
        Cmb_BanZu.Text = Cmb_BanZu.List(0)
        Cmb_SiteTime.Text = Cmb_SiteTime.List(0)
        Cmb_MNumber.Clear
        Cmb_MName.Clear
        '重置网格(Fixed)
        With WglrGrid
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
            
            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With
        
        
    End If
    
    '设置操作状态为浏览
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    
End Sub

Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
    
    Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
    Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
    Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
    Dim Rowjsq As Long                                    '网格行计数器
    Dim Coljsq As Long                                    '网格列计数器
    Dim Jsqte As Integer                                  '临时计数器
    Dim Lng_RowCount As Long                              '有效数据行计数器
    Dim Lrywlz As Long                                    '录入有误列值
    Dim Bln_Hg As Boolean                                 '检验合格标志
    Dim Str_Check As String                               '检验结果字符串
    Dim Str_Stand As String                               '检验标准字符串
    Dim Str_PanduanFu                                     '检验判断符
    Bln_Hg = True                                         '初始设为合格
    Sub_SaveBill = False
    
    '一.============先对单据内容进行有效性判断==============='
    
    '先进行字段不能为空或不能为零有效性判断(Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 8) = 1 Then     '字段不能为空
            If Len(Trim(LrText(Jsqte).Text)) = 0 Then
                Tsxx = Textstr(Jsqte, 7) & "不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Jsqte).SetFocus
                Exit Function
            End If
        Else
            If Textint(Jsqte, 8) = 2 Then   '字段不能为零
                If Val(Trim(LrText(Jsqte).Text)) = 0 Then
                    Tsxx = Textstr(Jsqte, 7) & "不能为零!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(Jsqte).SetFocus
                    Exit Function
                End If
            End If
        End If
    Next Jsqte
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
            If Not TextYxxpd(Jsqte) Then
                Call TextShow(Jsqte)
                Exit Function
            End If
        End If
    Next Jsqte
    
    '[>>
    
    '可在此区域写入其他对单据表头内容的有效性判断.
    '生产线不能为空
    If Trim(Cmb_LineName.Text) = "" Then
        Tsxx = "生产线不能为空"
        Call Xtxxts(Tsxx, 0, 4)
        Cmb_LineName.SetFocus
        Exit Function
    End If
    '物料名称不能为空
    If Trim(Cmb_MName.Text) = "" Then
        Tsxx = "物料名称