⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 +

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
        
        '1.2进行其他有效性判断,编写格式同1.1
        
        '2.放置行处理程序(当数据行通过有效性判断)
        
        '以上为自定义部分<<]
    End With    'WglrGrid
    
    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
    
Lrcwcl:      '录入错误处理
    With WglrGrid
        
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
        changelock = True
        .Select Yxxpdh, Lrywlz
        changelock = False
        Call xswbk
        
        '函数返回False
        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function

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                                    '录入有误列值
    Dim TotalShje As Single                               '汇总收回金额
    Dim Rec_BadDebt As New ADODB.Recordset                '回写坏帐发生动态集
    Dim Rec_AccList As New ADODB.Recordset                '回写应收明细帐
    Dim BadID As Integer                                  '坏帐标识ID
    Dim Rec_AccListAdd As New ADODB.Recordset             '临时使用动态集(追加记录)
    Dim Rec_AccSum As New ADODB.Recordset                 '临时动态集(追加总帐)
    Dim Str_PSCode As String                              '客户编码
    Dim Str_DeptCode As String                            '部门编码
    Dim Str_PersonCode As String                          '经办人编码
    Dim Str_ForeignCurrCode As String                     '币别编码
    Dim Rec_TempPd As New ADODB.Recordset                 '判断坏帐损失和收款单上的客户是否一致

    Sub_SaveBill = False
    
    '一.============先对单据内容进行有效性判断==============='
    
    '坏帐损失客户和收款单的客户是否相同,如果不一致,则不能进行坏帐收回处理
    If Trim((LrText(0).Text) & "") <> "" Then
        Set Rec_TempPd = Cw_DataEnvi.DataConnect.Execute("Select BillCode From RP_AccList Where BillCode='" & Trim((LrText(0).Text) & "") & "' and PsCode='" & Trim((LrText(1).Tag) & "") & "'")
        If Not Rec_TempPd.EOF Then
           If Trim(Rec_TempPd.Fields("BillCode") & "") = "" Then
              Tsxx = "收款单和坏帐损失的客户不一致,请重新输入收款单!!"
              Call Xtxxts(Tsxx, 0, 1)
              LrText(0).SetFocus
              Exit Function
           End If
        End If

    End If
    
    '先进行字段不能为空或不能为零有效性判断(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
                Call TextShow(jsqte)
                Exit Function
            End If
        End If
    Next jsqte
    
    
    '判断币别是否相同,如果不同,则不能进行坏帐收回处理
    With WglrGrid
        For Rowjsq = .FixedRows To .Rows - 1
            If .TextMatrix(Rowjsq, 0) = "*" And .TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
                If Trim(LrText(2).Tag) <> Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) Then
                    Tsxx = "币别不相同,不能进行坏帐收回处理!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Function
                End If
            End If
        Next Rowjsq
    End With
    '判断收款金额是否大于收款余额
    TotalShje = 0
    For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
        '带*号者为有效数据行(Fixed)
        If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
            Exit For
        Else
            If WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
                TotalShje = TotalShje + WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls))
            End If
        End If
    Next Rowjsq
    
    If Val(LrText(5).Tag) < Val(LrText(5).Text) Then
        Tsxx = "收款金额不能大于收款单上的金额!"
        Call Xtxxts(Tsxx, 0, 1)
        LrText(5).SetFocus
        Exit Function
    End If
    
    If Val(LrText(5).Text) <> TotalShje Then
        Tsxx = "坏帐收回金额不等于收款金额!"
        Call Xtxxts(Tsxx, 0, 1)
        LrText(5).SetFocus
        Exit Function
    End If
    
    
    '判断单据日期是否有效,如果单据日期所在的会计期间已经结帐,则不能保存
    If Not Fun_GetPeriod(CDate(Format(LrText(6).Text, "yyyy-mm-dd")), Int_Kjyear, Int_Period) Then
        LrText(6).SetFocus
        Exit Function
    End If
    
    '[>>
    
    '可在此区域写入其他对单据表头内容的有效性判断.
    
    '<<]
    
    '[>>下面将对所有有效数据行进行有效性判断
    
    Lng_RowCount = 0
    
    With WglrGrid
        For Rowjsq = .FixedRows To .Rows - 1
            '带*号者为有效数据行(Fixed)
            If .TextMatrix(Rowjsq, 0) <> "*" And .TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
                Exit For
            Else
                Lng_RowCount = Lng_RowCount + 1
            End If
            
            '1.首先进行为空或为零判断(Fixed)
            
            For jsqte = Qslz To .Cols - 1
                
                '字段不能为空
                If GridInt(jsqte, 5) = 1 Then
                    If Len(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
                        Tsxx = GridStr(jsqte, 2)
                        Lrywlz = jsqte
                        GoTo Lrcwcl
                        Exit For
                    End If
                End If
                
                '字段不能为零
                If GridInt(jsqte, 5) = 2 Then
                    If Val(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
                        Tsxx = GridStr(jsqte, 2)
                        Lrywlz = jsqte
                        GoTo Lrcwcl
                        Exit For
                    End If
                End If
            Next jsqte
            
            
            '2.判断存货编码是否存在(Define)
        Next Rowjsq
        
        '单据分录行数不能为零(Fixed)
        If Lng_RowCount = 0 Then
            Tsxx = "没有进行坏帐收回处理,不能保存!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
        
        '[>>
        '此处可以定义整张单据不能通过有效性检查的理由
        '<<]
    End With  '网格
    
    If Sub_Run = False Then
        Exit Function
    End If

    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
    
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    
    '2.对单据子表进行处理
    
    '打开单据子表动态集
    If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
    Rec_VouchSub.Open "Select * From RP_BadDebt Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
    '将网格中有效数据行写入单据子表
    For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
        If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
            Exit For
        End If
        
        If WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then

        With Rec_VouchSub
            .AddNew
            .Fields("PsCode") = Trim(LrText(1).Tag)                                                      '客户编码
            .Fields("BillCode") = Trim(LrText(0).Text)                                                   '结算单号
            .Fields("DeptCode") = Trim((LrText(3).Tag) & "")                                             '部门
            .Fields("PersonCode") = Trim((LrText(4).Tag) & "")                                           '经办人
            .Fields("BillDate") = Format(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)), "yyyy-mm-dd") '坏帐发生日期
            .Fields("DebtDate") = Format(LrText(6).Text, "yyyy-mm-dd")                                   '坏帐收回日期
            .Fields("KjYear") = Int_Kjyear                                                               '会计年度
            .Fields("Period") = Int_Period                                                               '会计期间
            .Fields("ForeignCurrCode") = Trim((LrText(2).Tag) & "")                                      '币别
            .Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))         '原币坏帐金额
            .Fields("YbSsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)))          '汇率
            .Fields("BbSsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)))          '本币坏帐金额
            .Fields("Digest") = Trim((LrText(7).Text) & "")                                              '摘要
            If Fun_GetAccInformation("AR_baddebtsMothed") = 1 Then
                .Fields("AccCode") = Fun_GetInputCode("AR_BadDebtPrepAccCode")                           '坏帐准备科目(备抵法)
            Else
                .Fields("AccCode") = Fun_GetInputCode("AR_BadDebtAccCode")                               '坏帐损失科目(非备抵法)
            End If
            .Fields("AccCodeArAp") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)))    '应收科目编码
            '输出单据类型
            .Fields("BadItemCode") = "61"
            .Update
                
        End With
        
        '将坏帐收回金额回写到坏帐文件
        BadID = WglrGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls))
        With Rec_BadDebt
             If .State = 1 Then .Close
            .Open "Select * From RP_BadDebt Where BadDebtId=" & BadID, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not Rec_BadDebt.EOF Then
                .Fields("YbSsje") = .Fields("YbSsje") + Rec_VouchSub.Fields("YbSsje")                   '原币坏帐收回金额
                .Fields("BbSsje") = .Fields("BbSsje") + Rec_VouchSub.Fields("BbSsje")                   '本币坏帐收回余额
               
               '判断是否全部收回坏帐
               If Val(.Fields("YbYsje")) = Val(.Fields("YbSsje")) Then
                   .Fields("BackFlag") = 1
               End If
               .Update
            End If
        End With
        
        '将收回坏帐回写到应收明细帐(收款单)
        With Rec_AccList
             If .State = 1 Then .Close
            .Open "Select * From RP_AccList Where BillCode='" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            
            If Not Rec_AccList.EOF Then
                .Fields("YbCancelje") = .Fields("YbCancelje") + Rec_VouchSub.Fields("YbSsje")           '核销原币金额
                .Fields("BbCancelje") = .Fields("BbCancelje") + Rec_VouchSub.Fields("BbSsje")           '核销本币金额
               
               '判断是否全部收回坏帐
               If Val(.Fields("YbSsje")) = Val(.Fields("YbCancelje")) Then
                   .Fields("OverStatus") = 1
               End If
               .Update
            End If
        End With
        
        '根据确定的坏帐收回记录登记到应收明细帐(其它应收)
        With Rec_AccListAdd
            If .State = 1 Then .Close
            .Open "Select * From RP_AccList", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            .AddNew
            .Fields("RPFlag") = "Ar"                                                            '应收/应付标识
            .Fields("PsCode") = Trim(Rec_VouchSub.Fields("PsCode"))                             '客户编码
            .Fields("BillDate") = Xtrq                                                          '单据日期
            .Fields("KjYear") = Int_Kjyear                                                      '会计年度
            .Fields("Period") = Int_Period                                                      '会计期间
            .Fields("BillItemCode") = "61"                                         

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -