VB开发的ERP系统

                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("first").Enabled = False   '首张
                .Buttons("prev").Enabled = False    '上张
                .Buttons("next").Enabled = False    '下张
                .Buttons("last").Enabled = False    '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(True)
        End Select
    End With
    
End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态

    '录入文本框状态设置
    If TextEnabled Then
        For jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(jsqte, 5) Then
                LrText(jsqte).Enabled = True
            Else
                LrText(jsqte).Enabled = False
            End If
        Next jsqte
    Else
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Enabled = False
        Next jsqte
    End If

End Sub

Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定审核弃审按钮状态
    If Trim(LrText(11).Text) <> "" And Trim(LrText(12).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
    Else
        Tlb_Action.Buttons("shsh").Enabled = False   '审核
    End If
    If Trim(LrText(11).Text) <> "" And Trim(LrText(12).Text) <> "" Then
        Tlb_Action.Buttons("shqs").Enabled = True      '弃审
    Else
        Tlb_Action.Buttons("shqs").Enabled = False   '弃审
    End If

End Sub

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    Dim jsqte As Long                             '临时计数器
    Dim Sqlstr As String
   
    '设置操作状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
       
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
   
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
      
    '录入文本框清除内容
    For jsqte = Max_Text_Index To 0 Step -1
        LrText(jsqte).Tag = ""
        LrText(jsqte).Text = ""
    Next jsqte
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    TextChangeLock = True
    LrText(0).Text = Xtrq
    '读取最新的单据编码
    LrText(1).Text = CreatBillCode(BillCode, False)
    LrText(11).Text = Xtczy
    LrText(12).Text = ""
    TextChangeLock = False
   
    '<<]
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    LrText(2).SetFocus
   
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
   
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
   
    '非有效单据不予进行修改动作
    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(11).Text = Xtczy
   
End Sub

Private Sub Sub_DeleteBill()                                               '删除当前单据
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim jsqte As Long                    '临时使用计数器
   
    '非有效单据不予进行删除动作
    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 Tr_roadlading Where roadladingId=" & 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
        '设置操作状态为浏览
        Lab_OperStatus = "1"
        Call Sub_OperStatus("10")
    End If

    Rec_Query.Requery
    Rec_Query.find "roadladingId=" & 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
    Changelock = False
    Valilock = False

    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("roadladingId")
        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

    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                                    '录入有误列值
    
    Sub_SaveBill = False
  
    '一.============先对单据内容进行有效性判断==============='
    '对需要进行事后判断的文本框录入内容进行有效性判断 (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
    '先进行字段不能为空或不能为零有效性判断(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
    
    If Trim(LrText(6).Text) <> "" And Trim(LrText(0).Text) <> "" Then
        If CDate(LrText(6).Text) < CDate(LrText(0).Text) Then
            Tsxx = Textstr(6, 7) & "不能小于" & Textstr(0, 7)
            Call Xtxxts(Tsxx, 0, 1)
            LrText(6).SetFocus
            Exit Function
        End If
    End If
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
   
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    If Trim(Lab_OperStatus) = "2" Then
    
        '新增单据
        
        '1.对于某些单据号自动生成的单据则可在此处自动生成
         LrText(1).Text = CreatBillCode(BillCode, True)
    
        '2.开始存盘
         
        '打开单据主表动态集
        If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
        Rec_VouchMain.Open "Select * From Tr_roadlading Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
             
        With Rec_VouchMain
            .AddNew
            .Fields("roadladingId") = CreatBillID(BillCode)
            .Fields("sendDate") = CDate(LrText(0).Text)
            .Fields("roadladingnum") = Trim(LrText(1).Text)
            .Fields("sourceCode") = Trim(LrText(2).Tag)
            .Fields("Mnumber") = Trim(LrText(3).Tag)
            .Fields("quantity") = Val(LrText(5).Text)
            If Trim(LrText(6).Text) = "" Then
                .Fields("returndate") = Null
            Else
                .Fields("returndate") = CDate(LrText(6).Text)
            End If
            .Fields("receivecode") = Trim(LrText(7).Tag)
            .Fields("trucksign") = Trim(LrText(8).Text)
            .Fields("driver") = Trim(LrText(9).Text)
            .Fields("remark") = Trim(LrText(10).Text)                                                      '备注
            .Fields("maker") = Xtczy                                                                      '制单人
            .Fields("Checker") = ""                                                                      '审核人置空
            .Update
            '系统读出单据ID写入Lab_BillID
            Lab_BillId.Caption = .Fields("roadladingId")
        End With
    Else
        '修改单据
        '打开单据主表动态集
        If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
        Rec_VouchMain.Open "Select * From Tr_roadlading  Where roadladingId=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_VouchMain
            .Fields("sendDate") = CDate(LrText(0).Text)
            .Fields("roadladingnum") = Trim(LrText(1).Text)
            .Fields("sourceCode") = Trim(LrText(2).Tag)
            .Fields("Mnumber") = Trim(LrText(3).Tag)
            .Fields("quantity") = Val(LrText(5).Text)
            If Trim(LrText(6).Text) = "" Then
                .Fields("returndate") = Null
            Else
                .Fields("returndate") = CDate(LrText(6).Text)
            End If
            .Fields("receivecode") = Trim(LrText(7).Tag)
            .Fields("trucksign") = Trim(LrText(8).Text)
            .Fields("driver") = Trim(LrText(9).Text)
            .Fields("remark") = Trim(LrText(10).Text)                                                      '备注
            .Fields("maker") = Xtczy                                                                      '制单人
            .Fields("Checker") = ""                                                                      '审核人置空
            .Update
        End With
    End If
         
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Sub_SaveBill = True
    Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(1).Text)
    Call Xtxxts(Tsxx, 0, 4)
    
    '标识单据发生改动
    Bln_BillChange = True
    
    '设置单据改变后的状态
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    Rec_Query.Requery
    Rec_Query.find "roadladingId=" & Val(Lab_BillId.Caption)
    
    Exit Function

Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    With WglrGrid
        Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End With
End Function

'选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"ArriveMainId"即可)
Private Sub Sub_First()             '首 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveFirst
        Lab_BillId.Caption = .Fields("roadladingId")
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_Prev()             '上 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MovePrevious
        If Not .BOF Then
            Lab_BillId.Caption = .Fields("roadladingId")
        Else