+

VB开发的ERP系统

    '删除单据后重置状态
        
    '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 "ReturnMoneyID=" & 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("ReturnMoneyID")
        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
  
    '[>>
  
    '可在此区域写入其他对单据表头内容的有效性判断,具体格式参照如下
   
    '<<]
    
    If Not Xs_AddNew(LrText(0).Text) Then Exit Function
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
   
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    If Trim(Lab_OperStatus) = "2" Then
        '新增单据
        
        '1.对于某些单据号自动生成的单据则可在此处自动生成
        LrText(1).Text = CreatBillCode(BillCode, True)
        LrText(1).Tag = CreatBillID(BillCode)
        
        '2.开始存盘
         
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select * From Xs_ReturnMoney Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .AddNew
            .Fields("kjyear") = XsYear          '会计年
            .Fields("period") = XsMm            '会计月
            .Fields("ReturnDate") = Format(LrText(0).Text, "yyyy-mm-dd")    '回款日期
            .Fields("ReturnMoneyID") = Trim(LrText(1).Tag)                  '回款ID
            .Fields("ReturnMoneyCode") = Trim(Me.LrText(1).Text)            '回款单号
            .Fields("RmtCode") = Trim(Me.LrText(2).Tag & "")                '回款类型
            .Fields("cusCode") = Trim(Me.LrText(3).Tag & "")                '客户编码
            .Fields("SsCode") = Trim(Me.LrText(4).Tag & "")                 '结算方式
            .Fields("deptCode") = Trim(LrText(5).Tag)                       '部门编码
            .Fields("personCode") = Trim(LrText(6).Tag & "")                '职员编码
            .Fields("bank") = Trim(LrText(7).Text & "")                     '开户行
            .Fields("bankaccount") = Trim(LrText(8).Text & "")              '银行帐号
            .Fields("Processor") = Trim(LrText(9).Text)                     '经办人
            If Trim(LrText(10).Text) <> "" Then
                .Fields("foreigncurrcode") = Trim(LrText(10).Tag & "")      '币种
                .Fields("exchrate") = Trim(LrText(11).Text & "")            '汇率
                .Fields("ReturnMoney") = Val(LrText(13).Text)               '回款金额
                If LrText(11).Tag = True Or LrText(11).Tag = "1" Then
                    .Fields("ConVertFlag") = 1                              '折算方式
                    .Fields("CapitalReturnMoney") = Format(Val(LrText(13).Text) / Val(LrText(11).Text), "###0." + String(Xtjexsws, "0"))   '本币回款金额
                Else
                    .Fields("ConVertFlag") = 0                              '折算方式
                    .Fields("CapitalReturnMoney") = Format(Val(LrText(13).Text) * Val(LrText(11).Text), "###0." + String(Xtjexsws, "0"))    '本币回款金额
                End If
                .Fields("CapitalRemainMoney") = Val(.Fields("CapitalReturnMoney"))              '核销剩余金额（原币）
            End If
            .Fields("billno") = Trim(LrText(12).Text & "")                  '票据号
            .Fields("signer") = Trim(LrText(14).Text & "")                  '签收人
            If Trim(LrText(15).Text) <> "" Then
                .Fields("signdate") = Format(LrText(15).Text, "yyyy-mm-dd")     '签收日期
            End If
            .Fields("remark") = Trim(LrText(16).Text)                       '备注
            .Fields("maker") = Trim(LrText(17).Text & "")                   '制单人
            .Fields("makerdate") = Format(Xtrq, "yyyy-mm-dd")               '制单日期
            .Update
            
            '系统读出单据ID写入Lab_BillID
            Lab_BillId.Caption = .Fields("ReturnMoneyID")
        End With
    Else
        '修改单据
       
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select * From Xs_ReturnMoney  Where ReturnMoneyID=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .Fields("kjyear") = XsYear          '会计年
            .Fields("period") = XsMm            '会计月
            .Fields("ReturnDate") = Format(LrText(0).Text, "yyyy-mm-dd")    '回款日期
            .Fields("ReturnMoneyID") = Trim(LrText(1).Tag)                  '回款ID
            .Fields("ReturnMoneyCode") = Trim(Me.LrText(1).Text)            '回款单号
            .Fields("RmtCode") = Trim(Me.LrText(2).Tag & "")                '回款类型
            .Fields("cusCode") = Trim(Me.LrText(3).Tag & "")                '客户编码
            .Fields("SsCode") = Trim(Me.LrText(4).Tag & "")                 '结算方式
            .Fields("deptCode") = Trim(LrText(5).Tag)                       '部门编码
            .Fields("personCode") = Trim(LrText(6).Tag & "")                '职员编码
            .Fields("bank") = Trim(LrText(7).Text)                          '开户行
            .Fields("bankaccount") = Trim(LrText(8).Text & "")              '银行帐号
            .Fields("Processor") = Trim(LrText(9).Text)                     '经办人
            If Trim(LrText(10).Text) <> "" Then
                .Fields("foreigncurrcode") = Trim(LrText(10).Tag & "")      '币种
                .Fields("exchrate") = Trim(LrText(11).Text & "")            '汇率
                .Fields("ReturnMoney") = Val(LrText(13).Text)               '回款金额
                If LrText(11).Tag = True Or LrText(11).Tag = "1" Then
                    .Fields("ConVertFlag") = 1                              '折算方式
                    .Fields("CapitalReturnMoney") = Format(Val(LrText(13).Text) / Val(LrText(11).Text), "###0." + String(Xtjexsws, "0"))   '本币回款金额
                Else
                    .Fields("ConVertFlag") = 0                              '折算方式
                    .Fields("CapitalReturnMoney") = Format(Val(LrText(13).Text) * Val(LrText(11).Text), "###0." + String(Xtjexsws, "0"))    '本币回款金额
                End If
                .Fields("CapitalRemainMoney") = Val(.Fields("CapitalReturnMoney"))              '核销剩余金额（原币）
            End If
            .Fields("billno") = Trim(LrText(12).Text & "")                  '票据号
            .Fields("signer") = Trim(LrText(14).Text & "")                  '签收人
            If Trim(LrText(15).Text) <> "" Then
                .Fields("signdate") = Format(LrText(15).Text, "yyyy-mm-dd")     '签收日期
            End If
            .Fields("remark") = Trim(LrText(16).Text)                       '备注
            .Fields("maker") = Trim(LrText(17).Text & "")                   '制单人
            .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 "ReturnMoneyID=" & Val(Lab_BillId.Caption)
    Exit Function
Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

End Function

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

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

'审核,弃审
Private Sub Sub_CheckBill()             '审 核
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
        Exit Sub
    End If
    '[>>
    Sqlstr = "Select Checker From Xs_ReturnMoney Where ReturnMoneyID='" & Val(Lab_BillId.Caption) & "'"
    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 Sub