+ަ

VB开发的ERP系统

        
        '标识单据发生改动
        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 "CheckScenarioID=" & 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                    '临时使用计数器
  
    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("CheckScenarioID")
        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_Bill As New ADODB.Recordset                   '单据表动态集
    Dim jsqte As Integer                                  '临时计数器
      
    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
                Exit Function
            End If
        End If
    Next jsqte
  
    '[>>
  
    '可在此区域写入其他对单据表头内容的有效性判断,具体格式参照如下
   
    '<<]
  
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
   
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    If Trim(Lab_OperStatus) = "2" Then
        '新增单据
        
        '1.对于某些单据号自动生成的单据则可在此处自动生成
        LrText(0).Text = CreatBillCode(BillCode, True)
        
        '2.开始存盘
         
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select * From Dev_CheckScenario Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .AddNew
            .Fields("CheckScenarioID") = CreatBillID(BillCode)      '方案ID
            .Fields("RepairMainCode") = Trim(Lab_Code.Caption)      '计划单号
            .Fields("RepairSubID") = Val(Lab_ID.Caption)            '子表ID
            .Fields("ScenarioCode") = Trim(LrText(0).Text)          '方案单号
            .Fields("DEVID") = Trim(LrText(1).Text)                 '设备编号
            .Fields("ScenarioType") = Trim(LrText(14).Text)         '计划类型
            .Fields("PlanRepairDate") = CDate(LrText(5).Text)       '检修日期
            .Fields("RepairPrepare") = Trim(LrText(6).Text)         '维修准备
            .Fields("RepairProgram") = Trim(LrText(7).Text)         '检修内容及程序
            .Fields("Safety") = Trim(LrText(8).Text)                '安全事项
            .Fields("Means") = Trim(LrText(9).Text)                 '验收方案
            .Fields("Standard") = Trim(LrText(10).Text)             '验收标准
            .Fields("Maker") = Xtczy                                '制表人
            .Fields("Authorizer") = ""                              '批准人
            .Fields("Checker") = ""                                 '审核人
            .Update
            Cw_DataEnvi.DataConnect.Execute ("update Dev_RepairSub set ScenarioFlag=1 where RepairMainID=" & Val(TempMainID) & " and RepairSubID=" & Val(Lab_ID.Caption))
            '系统读出单据ID写入Lab_BillID
            Lab_BillId.Caption = .Fields("CheckScenarioID")
        End With
    Else
        '修改单据
       
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select * From Dev_CheckScenario  Where CheckScenarioID=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .Fields("RepairMainCode") = Trim(Lab_Code.Caption)      '计划单号
            .Fields("RepairSubID") = Val(Lab_ID.Caption)            '子表ID
            .Fields("ScenarioCode") = Trim(LrText(0).Text)          '方案单号
            .Fields("DEVID") = Trim(LrText(1).Text)                 '设备编号
            .Fields("ScenarioType") = Trim(LrText(14).Text)         '计划类型
            .Fields("PlanRepairDate") = CDate(LrText(5).Text)       '检修日期
            .Fields("RepairPrepare") = Trim(LrText(6).Text)         '维修准备
            .Fields("RepairProgram") = Trim(LrText(7).Text)         '检修内容及程序
            .Fields("Safety") = Trim(LrText(8).Text)                '安全事项
            .Fields("Means") = Trim(LrText(9).Text)                 '验收方案
            .Fields("Standard") = Trim(LrText(10).Text)             '验收标准
            .Fields("Maker") = Xtczy                                '制表人
            .Fields("Authorizer") = ""                              '批准人
            .Fields("Checker") = ""                                 '审核人
            .Update
        End With
    End If
         
    Cw_DataEnvi.DataConnect.CommitTrans

    Sub_SaveBill = True
    Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(0).Text)
    Call Xtxxts(Tsxx, 0, 4)
  
    '标识单据发生改动
    Bln_BillChange = True
  
    '设置单据改变后的状态
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    Rec_Query.Requery
    Rec_Query.Find "CheckScenarioID=" & Val(Lab_BillId.Caption)
    Exit Function
Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

End Function

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

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

End Sub

Private Sub Sub_Next()             '下 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .EOF Then
            .MoveNext
        End If
      
        If Not .EOF Then
            Lab_BillId.Caption = .Fields("CheckScenarioID")
        Else
            .MovePrevious
        End If
     
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_Last()              '末 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveLast
        Lab_BillId.Caption = .Fields("CheckScenarioID")
        Call Sub_ShowBill
    End With

End Sub
    
'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]

'审核,弃审
Private Sub Sub_CheckBill()             '审 核
    '[>>
    
    '此处可以写入禁止单据审核的理由
       
    '<<]
     If Not Security_Log("Dev_MonthRepairFACheck", Xtczybm, 1, True) Then
        Exit Sub
     End If
    '将单据写入审核标识
    Cw_DataEnvi.DataConnect.Execute ("Update Dev_CheckScenario Set Checker='" & Xtczy & "' Where CheckScenarioID=" & Val(Lab_BillId.Caption))
    
    '写入系统操作员
    LrText(12).Text = Xtczy
    
    '设置审核弃审按钮状态
    Call Sub_CheckStatus
    
    '标识单据发生变化
    Bln_BillChange = True

End Sub

Private Sub Sub_AbandonCheck()          '弃 审
   '[>>
    
    '此处可以写入禁止单据弃审的理由
       
    '<<]
     If Not Security_Log("Dev_MonthRepairFACheck", Xtczybm, 1, True) Then
        Exit Sub
     End If
    '将单据清除审核标识
    Cw_DataEnvi.DataConnect.Execute ("Update Dev_CheckScenario Set Checker='' Where CheckScenarioID=" & Val(Lab_BillId.Caption))
    
    '清空单据审核人
    LrText(12).Text = ""
    
    '设置审核弃审按钮状态
    Call Sub_CheckStatus
    
    '标识单据发生变化
    Bln_BillChange = True
  
End Sub
Private Sub Sub_AuthorizerBill()             '批准
    '[>>
    
    '此处可以写入禁止单据审核的理由
       
    '<<]
     If Not Security_Log("Dev_MonthRepairFACheck", Xtczybm, 1, True) Then
        Exit Sub
     End If