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

📄 +

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
    Dim Str_Ccode As String                '临时索引编码

    With WglrGrid

        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
    
        '以下为自定义部分[
    
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For jsqte = Qslz To .Cols - 1
            '字段不能为空
            If GridInt(jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, 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(Yxxpdh, jsqte))) = 0 Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next jsqte
    
    
        '1.2进行其他有效性判断,编写格式同1.1
                
        '2.放置行处理程序(当数据行通过有效性判断)
           
    End With

    '以上为自定义部分]

    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

Lrcwcl:      '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        changelock = True
        .Select Yxxpdh, Lrywlz
        changelock = False
        Call xswbk
        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 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                     '币别编码
    
    Sub_SaveBill = False
    
    '一.============先对单据内容进行有效性判断==============='
    
    '[>>下面将对所有有效数据行进行有效性判断
    
    Lng_RowCount = 0
    
    With WglrGrid
        For Rowjsq = .FixedRows To .Rows - 1
            '带*号者为有效数据行(Fixed)
            If .TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            Else
                If .TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
                    Lng_RowCount = Lng_RowCount + 1
                End If
            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
            
        Next Rowjsq
        
        '单据分录行数不能为零(Fixed)
        If Lng_RowCount = 0 Then
            Tsxx = "没有进行坏帐损失处理,不能保存!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
        
        '[>>
        '此处可以定义整张单据不能通过有效性检查的理由
        '<<]
    End With  '网格
    
     '判断单据日期是否有效,如果单据日期所在的会计期间已经结帐,则不能保存
    If Not Fun_GetPeriod(CDate(Format(Xtrq, "yyyy-mm-dd")), Int_Kjyear, Int_Period) Then
        Exit Function
    End If
    
    If Sub_Run = False Then
        Exit Function
    End If
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
    
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.对网格固定行进行处理
    If Trim(Lab_OperStatus) = "2" Then
        
    '打开单据子表动态集
    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(Me.Lab_Cust.Tag)                                                               '客户编码
                .Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))                    '摘要
                .Fields("BillItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("018", GridStr(), Szzls)))              '单据类型
                .Fields("BillCode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))                  '单据号
                .Fields("BillDate") = Format(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)), "yyyy-mm-dd")  '单据日期
                .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))                  '部门
                .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)))                '经办人
                .Fields("DebtDate") = Format(Xtrq, "yyyy-mm-dd")                                                        '坏帐日期
                .Fields("KjYear") = Int_Kjyear                                                                          '会计年度
                .Fields("Period") = Int_Period                                                                          '会计期间
                .Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)))           '币别
                .Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("014", GridStr(), Szzls)))                    '原币坏帐金额
                .Fields("YbYsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("015", GridStr(), Szzls)))                     '汇率
                .Fields("BbYsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("017", GridStr(), Szzls)))                     '本币坏帐金额
                
                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("016", GridStr(), Szzls)))               '应收科目编码
                '输出单据类型
                .Fields("BadItemCode") = "60"
                
                '凭证信息
                .Fields("VouchId") = EffectVouchId
                .Fields("IfBuildVouch") = True
                .Update
                
            End With
            
            Dim Rec_AccList As New ADODB.Recordset
            Dim BillNo As String
            
            '根据坏帐损失回写明细帐核销数据(回写坏帐损失)
            BillNo = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))
            With Rec_AccList
                 If .State = 1 Then .Close
                .Open "Select * from RP_AccList Where BillCode='" & BillNo & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If Not Rec_AccList.EOF Then
                    .Fields("YbCancelje") = .Fields("YbCancelje") + Rec_VouchSub.Fields("YbYsje")               '原币核销金额
                    .Fields("BbCancelje") = .Fields("BbCancelje") + Rec_VouchSub.Fields("BbYsje")               '本币核销金额
                    If Val(.Fields("YbCancelje")) = Val(.Fields("YbYsje")) 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") = "60"                                                                  '单据类型(坏帐损失)
                .Fields("BillID") = 0                                                                           '凭证号
                .Fields("BillCode") = 0                                                                         '单据号
                .Fields("Digest") = "坏帐损失"                                                                  '摘要
                .Fields("ForeignCurrCode") = Trim(Rec_VouchSub.Fields("ForeignCurrCode") & "")                  '币别
                .Fields("AccRate") = Val(Rec_VouchSub.Fields("AccRate"))                                        '汇率
                .Fields("YbYsje") = -Val(Rec_VouchSub.Fields("YbYsje"))                                         '原币应收金额
                .Fields("BbYsje") = -Val(Rec_VouchSub.Fields("BbYsje"))                                         '本币应收金额
                .Fields("DeptCode") = Trim(Rec_VouchSub.Fields("DeptCode") & "")                                '部门编码
                .Fields("PersonCode") = Trim(Rec_VouchSub.Fields("PersonCode") & "")                            '经办人编码
                .Fields("Maker") = Xtczy                                                                        '制单
                .Fields("Checker") = Xtczy                                                                      '审核
                .Fields("AccCode") = Trim(Rec_VouchSub.Fields("AccCode") & "")                                  '坏帐准备科目(损失科目)
                .Fields("AccCodeArAp") = Trim(Rec_VouchSub.Fields("AccCodeArAp") & "")                          '应收科目编码
                '因为核销追加核销标识
                .Fields("OverStatus") = 1                                                                       '是否核销完毕标识
                
                '凭证信息
                .Fields("VouchId") = EffectVouchId
                .Fields("IfBuildVouch") = True

                .Update
                
            End With
            
            '根据确定的坏帐损失登记应收/应付总帐
            Str_PSCode = Trim(Rec_VouchSub.Fields("PSCode") & "")
            Str_DeptCode = Trim(Rec_VouchSub.Fields("DeptCode") & "")
            Str_PersonCode = Trim(Rec_VouchSub.Fields("PersonCode") & "")
            Str_ForeignCurrCode = Trim(Rec_VouchSub.Fields("ForeignCurrCode") & "")
            
            With Rec_AccSum
                If .State = 1 Then .Close
               .Open "Select * From RP_AccSum Where RpFlag='Ar' And PSCode='" & Str_PSCode & _
                "' And DeptCode='" & Str_DeptCode & "' And PersonCode='" & Str_PersonCode & "' And ForeignCurrCode='" & Str_ForeignCurrCode & "' And kjYear=" & Int_Kjyear & " And Period=" & Int_Period, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                
                If Not Rec_AccSum.EOF Then
                   .Fields("YbYsje") = .Fields("YbYsje") - Rec_VouchSub.Fields("YbYsje")                 '本期应收/应付原币金额
                   .Fields("YbQmye") = .Fields("YbQcye") + .Fields("YbYsje") - .Fields("YbSsje")         '本期期末原币余额
                   .Fields("BbYsje") = .Fields("BbYsje") - Rec_VouchSub.Fields("BbYsje")                 '本期应收/应付本币金额
                   .Fields("BbQmye") = .Fields("BbQcye") + .Fields("BbYsje") - .Fields("BbSsje")         '本期期末本币余额
                   .Update
                Else
                   .AddNew
                   .Fields("RPFlag") = "Ar"                                                              '应收应付标识
                   .Fields("PSCode") = Str_PSCode                                                        '往来单位编码
                   .Fields("DeptCode") = Str_DeptCode                                                    '部门编码
                   .Fields("PersonCode") = Str_PersonCode                                                '个人编码
                   .Fields("ForeignCurrCode") = Str_ForeignCurrCode                                      '原币编码
                   .Fields("KJYear") = Int_Kjyear                                                        '会计年度
                   .Fields("Period") = Int_Period                                                        '会计期间
                   .Fields("YbYsje") = -Rec_VouchSub.Fields("YbYsje")                                    '本期应收/应付原币金额
                   .Fields("YbQmye") = -Rec_VouchSub.Fields("YbYsje")                                    '本期期末原币余额
                   .Fields("BbYsje") = -Rec_VouchSub.Fields("BbYsje")                                    '本期应收/应付本币金额
                   .Fields("BbQmye") = -Rec_VouchSub.Fields("BbYsje")                                    '本期期末本币余额
                   .Update
            
                 End If
            End With
        
        End If
    Next Rowjsq
    End If

⌨️ 快捷键说明

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