˪-i㦥

VB开发的ERP系统

            If OptReceNoteType(1).Enabled = True Then
                .Fields("AccCode") = Fun_GetInputCode("AR_CommNoteAccCode") '商业承兑汇票科目
            Else
                .Fields("AccCode") = Fun_GetInputCode("AR_BankNoteAccCode") '银行承兑汇票科目
            End If
            .Fields("AccCodeInterest") = Fun_GetInputCode("AR_NoteIntAccCode") '票据利息科目
            
            .Update
            
            '系统读出单据ID写入Lab_BillID
            Lab_BillId.Caption = .Fields("NoteID")
             '添
            Lab_NoteStatus.Caption = .Fields("Fstatus")
        End With
    Else
        '修改单据
       
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select * From Rp_Note  Where NoteID=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rec_Bill
            .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 Lab_Start.Caption = "期初" Then
                .Fields("StartFlag") = 1                                  '期初录入
                .Fields("KjYear") = Int_Kjyear                            '当前年度
                .Fields("Period") = 1                                     '第一会计期间
            Else
                .Fields("StartFlag") = 0                                  '非期初录入
                .Fields("KjYear") = Int_Kjyear
                .Fields("Period") = Int_Period
            End If
            .Fields("Fstatus") = 9                                        '=9表示收票状态
            
            '系统名
            .Fields("RPFlag") = "Ar"
            
            '单据类型
            If OptReceNoteType(1).Value = True Then
               .Fields("BillItemCode") = "01"                             '商业承兑汇票类型
            Else
               .Fields("BillItemCode") = "02"                             '银行承兑汇票类型
            End If
            
            '应收帐款科目
            .Fields("AccCodeArAp") = Fun_InputCodeCustomer(LrText(2).Tag, 0)
            
            '应收票据科目
            If OptReceNoteType(1).Enabled = True Then
                .Fields("AccCode") = Fun_GetInputCode("AR_CommNoteAccCode") '商业承兑汇票科目
            Else
                .Fields("AccCode") = Fun_GetInputCode("AR_BankNoteAccCode") '银行承兑汇票科目
            End If
            .Fields("AccCodeInterest") = Fun_GetInputCode("AR_NoteIntAccCode") '票据利息科目
            .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 "NoteID=" & Val(Lab_BillId.Caption)
    Exit Function
Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

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

'审核,弃审
Private Sub Sub_CheckBill()             '审 核
    Dim RecTemp As New ADODB.Recordset
    '[>>
    
    '此处可以写入禁止单据审核的理由
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ar_Note_Check", Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    If Trim(Lab_Start.Caption) = "期初" Then           '期初应收票据不必登记应收帐
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Checker From RP_Note Where NoteID='" & Val(Lab_BillId.Caption) & "'")
        If Not RecTemp.EOF Then
            If Trim(RecTemp.Fields("Checker") & "") <> "" Then
                Tsxx = "该单据已审核,不需再次审核!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            Else
                '将单据写入审核标识
                Cw_DataEnvi.DataConnect.Execute ("Update Rp_Note Set Checker='" & Xtczy & "' Where NoteID=" & Val(Lab_BillId.Caption))
    
                '写入系统操作员
                LrText(15).Text = Xtczy
    
                '设置审核弃审按钮状态
                Call Sub_CheckStatus
                Call Sub_CheckNoteStatus
                '标识单据发生变化
                Bln_BillChange = True
            End If
        End If
    Else
    
        '加记帐过程的过程
        If Fun_CheckNote(Val(Lab_BillId.Caption)) = True Then         '审核过帐
    
            '将单据写入审核标识
            Cw_DataEnvi.DataConnect.Execute ("Update Rp_Note Set Checker='" & Xtczy & "' Where NoteID=" & Val(Lab_BillId.Caption))
    
            '写入系统操作员
            LrText(15).Text = Xtczy
    
    
            '设置审核弃审按钮状态
            Call Sub_CheckStatus
            Call Sub_CheckNoteStatus
            '标识单据发生变化
            Bln_BillChange = True
        End If
    End If
End Sub


Private Function Fun_AllowEdit() As Boolean                      '判断当前单据是否允许编辑或删除
  
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Fun_AllowEdit = False
    Sqlstr = "Select Checker,FStatus From Rp_Note Where NoteID=" & 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 Function
            End If
            '添
            If Val(Trim(.Fields("FStatus") & "")) <> 9 Then
                Tsxx = "该票据已经变动,不能修改或删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowEdit = True

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

'*****************************以下为文本框录入处理程序(固定不变部分)*******************************'

'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  
    '以下为依据实际情况自定义部分[
  
    '在此填写文本框录入事后处理程序
    Select Case Index
         Case 6, 7, 8
            TextChangeLock = True
            If Index = 6 Then           '币别
                If Trim(LrText(6).Tag) = XtSCurrCode Then
                    LrText(8).Text = 1
                Else
                    Call Sub_GetAccRate(LrText(6).Tag, Bln_ConVertFlag, Dbl_AccRate)    '取外币记帐汇率
                    If Dbl_AccRate <> 0 Then
                        LrText(8).Text = Dbl_AccRate
                    Else
                        LrText(8).Text = ""
                    End If
                End If
            End If
            If Bln_ConVertFlag Then
                If Val(LrText(8).Text) <> 0 Then
                    Dbl_Bbje = Val(Format(Val(LrText(7).Text) / Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
                Else
                    Dbl_Bbje = 0
                End If
            Else
                Dbl_Bbje = Val(Format(Val(LrText(7).Text) * Val(LrText(8).Text), "##." + String(Xtjexsws, "0")))
            End If
            LrText(9).Text = Dbl_Bbje
            TextChangeLock = False
      End Select
   
    ']以上为依据实际情况自定义部分
  
End Sub

Private Sub LrText_Change(Index As Integer)
    
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
    
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
     
    Select Case Textint(Index, 1)
        Case 8, 11      '金额型
            Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
        Case 9, 12      '数量型
            Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
        Case 10          '单价型
            Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
        Case Else        '其他小数类型控制
            If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
                Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
            End If
    End Select
        
    TextChangeLock = False '解锁

End Sub

Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
    
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))

End Sub

Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    
    Select Case KeyCode
        Case vbKeyF2
            Call Text_Help(Index)
    End Select

End Sub

Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub

Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点

    '显示相应信息但不能进行有效性判断
    Call Wbklrwbcl(Index)
    
    
End Sub

Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助

    '文本框处于非录入状态时不允许调入帮助
    If Not LrText(Index).Enabled Then
        Exit Sub
    End If
   
    Call Text_Help(Index)

End Sub

Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
     
    '调用帮助
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  
    '根据设置选择显示编码和名称,并进行存储
    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
   
    LrText(Index).SetFocus

End Sub

Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息

    '填写文本框得到焦点,进行相应信息处理程序
End S