˪

VB开发的ERP系统

   
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
   
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
   
    '设置工具条状态
    Call Sub_OperStatus("30")
      
    '显示制单人
    LrText(14).Text = Xtczy
   
End Sub

Private Sub Sub_DeleteBill()                                               '删除当前单据
    
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim Jsqte As Long                    '临时使用计数器
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ap_Note_Edit", 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 Rp_Note Where NoteID=" & Val(Lab_BillId.Caption))
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '标识单据发生改动
        Bln_BillChange = True
        
        '单据ID置0
        Lab_BillId.Caption = 0
        Lab_NoteStatus.Caption = ""
    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 "NoteID=" & Val(Lab_BillId.Caption)
    Exit Sub
Swcwcl:          '单据删除时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
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("NoteID")
            '添
            Lab_NoteStatus.Caption = Trim(.Fields("Fstatus") & "")
        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
        .MoveNext
      
        If Not .EOF Then
            Lab_BillId.Caption = .Fields("NoteID")
            '添
            Lab_NoteStatus.Caption = Trim(.Fields("Fstatus") & "")
            
        Else
            .MovePrevious
        End If
     
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
 
    Dim Jsqte As Long                    '临时使用计数器
    
  
    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("NoteID")
        '添
        Lab_NoteStatus.Caption = Trim(Rec_Query.Fields("Fstatus") & "")
        Call Sub_ShowBill
    Else
        '单据ID置为0
        Lab_BillId.Caption = 0
        '添
        Lab_NoteStatus.Caption = ""
        '清除录入文本框
        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                                  '临时计数器
    Dim Int_Kjyear As Integer                             '会计年度
    Dim Int_Period 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
  
    '[>>
        '1.判断单据日期是否有效,如有效同时记录会计年度和会计期间
    If Not Fun_GetPeriod(Trim(LrText(1).Text), Int_Kjyear, Int_Period) Then
        LrText(1).SetFocus
        Exit Function
    End If
     '2.如果用户选择币种为本位币则汇率必须为1，否则汇率不能为零
    If Trim(LrText(6).Tag) <> XtSCurrCode Then
       If Val(LrText(8).Text) = 0 Then
          Tsxx = "汇率不能为零!"
          Call Xtxxts(Tsxx, 0, 1)
          LrText(8).SetFocus
          Exit Function
       End If
    Else
       LrText(8).Text = 1
    End If
    If Bln_ConVertFlag Then
        LrText(9).Text = Val(Format(Val(LrText(7).Text) / Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
    Else
        LrText(9).Text = Val(Format(Val(LrText(7).Text) * Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
    End If
    '<<]
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'

  
    '可在此区域写入其他对单据表头内容的有效性判断,具体格式参照如下
   
    '<<]
  
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
   
    '对存盘进行事务处理(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 Rp_Note Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .AddNew
            .Fields("NoteId") = CreatBillID(BillCode)                     '单据ID
            .Fields("NoteCode") = Trim(LrText(0).Text)                    '单据号
            .Fields("BillDate") = CDate(LrText(1).Text)                   '单据日期
            .Fields("PsCode") = Trim(LrText(2).Tag)                       '供应商编码
            .Fields("SignDate") = CDate(LrText(3).Text)                   '签发日期
            .Fields("ExpireDate") = CDate(LrText(4).Text)                 '到期日期
            .Fields("Payer") = Trim(LrText(5).Text)                       '收款人
            .Fields("ForeignCurrCode") = Trim(LrText(6).Tag)              '原币编码
            .Fields("YbSsJe") = Val(Val(LrText(7).Text))                  '票面金额
            .Fields("AccRate") = Val(Trim(LrText(8).Text))                '记帐汇率
            .Fields("BbSsJe") = Val(Trim(LrText(9).Text))                 '本币金额
            .Fields("YbInterest") = Val(Trim(LrText(10).Text))            '票面原币利息
            If Bln_ConVertFlag Then
                .Fields("BbInterest") = Val(Format(Val(LrText(10).Text) / Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
            Else
                .Fields("BbInterest") = Val(Format(Val(LrText(10).Text) * Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
            End If
            
            .Fields("DeptCode") = Trim(LrText(11).Tag)                    '部门
            .Fields("PersonCode") = Trim(LrText(12).Tag)                  '经办人
            .Fields("Digest") = Trim(LrText(13).Text)                     '备注
            .Fields("Maker") = Trim(LrText(14).Text)                      '制单人
            .Fields("Checker") = ""                                       '审核人置空
            If Trim(Lab_Start.Caption) = "期初" Then
                .Fields("IfBuildVouch") = True                            '应付票据已生成凭证
                .Fields("StartFlag") = 1                                  '期初录入
                .Fields("KjYear") = Int_Kjyear                            '当前年度
                .Fields("Period") = 1                                     '第一会计期间
            Else
                .Fields("IfBuildVouch") = False
                .Fields("StartFlag") = 0                                  '非期初录入
                .Fields("KjYear") = Int_Kjyear
                .Fields("Period") = Int_Period
            End If
            .Fields("Fstatus") = 9                                        '=9表示付票状态
            
            '系统名
            .Fields("RPFlag") = "Ap"
            
            '单据类型
            If OptReceNoteType(0).Value = True Then
               .Fields("BillItemCode") = "B1"                             '商业承兑汇票类型
            Else
               .Fields("BillItemCode") = "B2"                             '银行承兑汇票类型
            End If
            
            '应付帐款科目(供应商对应的应付科目)
            .Fields("AccCodeArAp") = Fun_InputCodeSupplier(LrText(2).Tag, 0)
            
            '应付票据科目
            If OptReceNoteType(1).Enabled = True Then
                .Fields("AccCode") = Fun_GetInputCode("AP_CommNoteAccCode")     '商业承兑汇票科目(应付)
            Else
                .Fields("AccCode") = Fun_GetInputCode("AP_BankNoteAccCode")     '银行承兑汇票科目(应付)
            End If
            .Fields("AccCodeInterest") = Fun_GetInputCode("AP_NoteIntAccCode")  '票据利息科目(应付)
            
            .Update
            
            '系统读出单据ID写入Lab_BillID
            Lab_BillId.Caption = .Fields("NoteID")
             '添
            Lab_NoteStatus.Caption = Trim(.Fields("Fstatus") & "")
        End With
    Else
        '修改单据