transferpubic.bas

金算盘软件代码

                        If .EmployeeID = 0 Then
                            VoucherData.IsError = True
                            VoucherData.ErrorString = "未指定科目" & AccountCode(.AccountID) & "的核算员工！"
                            Exit For
                        End If
                    End If
                    If (.Attribute And aaJob) = aaJob Then
                        If .JobID = 0 Then
                            VoucherData.IsError = True
                            VoucherData.ErrorString = "未指定科目" & AccountCode(.AccountID) & "的核算工程！"
                            Exit For
                        End If
                    End If
                    If (.Attribute And aaClass1) = aaClass1 Then
                        If .ClassID1 = 0 Then
                            VoucherData.IsError = True
                            VoucherData.ErrorString = "未指定科目" & AccountCode(.AccountID) & "的统计项目！"
                            Exit For
                        End If
                    End If
                    If (.Attribute And aaClass2) = aaClass2 Then
                        If .ClassID2 = 0 Then
                            VoucherData.IsError = True
                            VoucherData.ErrorString = "未指定科目" & AccountCode(.AccountID) & "的核算项目！"
                            Exit For
                        End If
                    End If
                End If
                If (.Attribute And aaQuantity) <> aaQuantity Then
                    .Quantity = 0
                End If
                If Not VoucherData.IsError And .CurrencyID = 0 Then
                    .CurrencyID = gclsBase.NaturalCurId
                    .CurrencyAmount = .Amount
                End If
                If VoucherData.IsError Then Exit For
            End With
        Next lngDetail
        '有发生额否
        If dblAmount = 0 And Not VoucherData.IsError Then
            VoucherData.IsError = True
            VoucherData.ErrorString = "没有数据可生成凭证！"
        End If
        '借贷是否平
        If Abs(dblDebit - dblCredit) >= (10 ^ (-gclsBase.NaturalCurDec - 1)) And Not VoucherData.IsError Then
            If lngBalance > -1 Then
                '自动补平
                VoucherData.Detail(lngBalance).Amount = VoucherData.Detail(lngBalance).Amount _
                    + (dblCredit - dblDebit) * VoucherData.Detail(lngBalance).Direction
            Else
                VoucherData.IsError = True
                If strFrom = "商品业务" Then
                    VoucherData.ErrorString = "凭证借贷不相等(若是商品业务单据请检查是否计算成本)！"
                Else
                    VoucherData.ErrorString = "凭证借贷不相等！"
                End If
            End If
        End If
        '检查凭证类别
        If VoucherData.VoucherTypeID = 0 And Not VoucherData.IsError Then
            VoucherData.IsError = True
            VoucherData.ErrorString = "凭证类别不能为空！"
        End If
        '检查凭证模板
        If VoucherData.VoucherTypeID > 0 And Not VoucherData.IsError Then
            strSql = "SELECT strVoucherFormat FROM VoucherType WHERE lngVoucherTypeID=" & VoucherData.VoucherTypeID
            'Set recType = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recType.EOF Then
                VoucherData.SourceVoucherID = C2lng(recType!strVoucherFormat)
                Select Case recType!strVoucherFormat
                Case "1"
                    If lngDebit <> 1 Then
                        VoucherData.IsError = True
                        VoucherData.ErrorString = "非一借多贷凭证，不能生成收款格式的凭证！"
                    End If
                Case "2"
                    If lngCredit <> 1 Then
                        VoucherData.IsError = True
                        VoucherData.ErrorString = "非一贷多借凭证，不能生成付款格式的凭证！"
                    End If
                End Select
            End If
            recType.Close
            Set recType = Nothing
        End If
        '生成凭证编号
        If VoucherData.VoucherNO <= 0 And Not VoucherData.IsError Then
            VoucherData.VoucherNO = CLng(GetMaxNO(Year(gclsBase.BaseDate), gclsBase.Period, _
                rtVoucher, CStr(VoucherData.VoucherTypeID), gclsBase.BaseDate))
            If VoucherData.VoucherNO <= 0 Then
                VoucherData.IsError = True
                If gclsBase.NoOrder Then
                    VoucherData.ErrorString = "自动生成的凭证编号不满足序时控制！"
                Else
                    VoucherData.ErrorString = "凭证编号生成失败！"
                End If
            End If
        End If
        '检查凭证借贷方是否完全一致
        If UBound(VoucherData.Detail) = 1 And Not VoucherData.IsError Then
            If VoucherData.Detail(0).AccountID = VoucherData.Detail(1).AccountID And _
                VoucherData.Detail(0).Amount = VoucherData.Detail(1).Amount And _
                VoucherData.Detail(0).CustomerID = VoucherData.Detail(1).CustomerID And _
                VoucherData.Detail(0).DepartmentID = VoucherData.Detail(1).DepartmentID And _
                VoucherData.Detail(0).EmployeeID = VoucherData.Detail(1).EmployeeID And _
                VoucherData.Detail(0).ClassID1 = VoucherData.Detail(1).ClassID1 And _
                VoucherData.Detail(0).ClassID2 = VoucherData.Detail(1).ClassID2 And _
                VoucherData.Detail(0).CurrencyID = VoucherData.Detail(1).CurrencyID Then
                VoucherData.IsError = True
                VoucherData.ErrorString = "凭证借贷方科目金额完全一致，不能生成凭证！"
            End If
        End If
        If lngDebit + lngCredit >= 2 Then
            If lngDebit = 0 Then
                VoucherData.Detail(0).Amount = VoucherData.Detail(0).Amount * (-1)
                VoucherData.Detail(0).Direction = adDebit
                lngDebit = 1
            End If
            If lngCredit = 0 Then
                VoucherData.Detail(lngDebit + lngCredit - 1).Amount = VoucherData.Detail(lngDebit + lngCredit - 1).Amount * (-1)
                VoucherData.Detail(lngDebit + lngCredit - 1).Direction = adCredit
                lngCredit = 1
            End If
        End If
        If lngDebit = 1 Then
            For lngDetail = 0 To UBound(VoucherData.Detail)
                If VoucherData.Detail(lngDetail).Direction = adDebit Then
                    VoucherData.Detail(lngDetail).DetailEntry = 1
                    Exit For
                End If
            Next lngDetail
        End If
        If lngCredit = 1 Then
            For lngDetail = 0 To UBound(VoucherData.Detail)
                If VoucherData.Detail(lngDetail).Direction = adCredit Then
                    VoucherData.Detail(lngDetail).DetailEntry = 0
                    Exit For
                End If
            Next lngDetail
        End If
    End If
End Sub

'检查凭证必有必无科目
Private Sub VoucherMustNo(VoucherData As VoucherRecord)
    Dim strSql As String
    Dim recType As rdoResultset
    Dim strDebit1 As String
    Dim strDebit2 As String
    Dim strCredit1 As String
    Dim strCredit2 As String
    Dim strMust1 As String
    Dim strMust2 As String
    Dim strNo1 As String
    Dim strNo2 As String
    Dim lngNo1 As Long
    Dim lngNo2 As Long
    Dim lngCnt As Long
    Dim lngCount As Long
    
    
    If Not VoucherData.IsError And VoucherData.Used Then
        strSql = "SELECT * FROM VoucherType WHERE lngVoucherTypeID=" & VoucherData.VoucherTypeID
        Set recType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recType.EOF Then
            If recType!lngDebitAccountID1 > 0 Then
                strDebit1 = AccountCode(recType!lngDebitAccountID1)
            End If
            If recType!lngDebitAccountID2 > 0 Then
                strDebit2 = AccountCode(recType!lngDebitAccountID2)
            End If
            If recType!lngCreditAccountID1 > 0 Then
                strCredit1 = AccountCode(recType!lngCreditAccountID1)
            End If
            If recType!lngCreditAccountID2 > 0 Then
                strCredit2 = AccountCode(recType!lngCreditAccountID2)
            End If
            If recType!lngVoucherAccountID1 > 0 Then
                strMust1 = AccountCode(recType!lngVoucherAccountID1)
            End If
            If recType!lngVoucherAccountID2 > 0 Then
                strMust2 = AccountCode(recType!lngVoucherAccountID2)
            End If
            If recType!lngVoucherNoAccountID1 > 0 Then
                lngNo1 = recType!lngVoucherNoAccountID1
                strNo1 = AccountCode(recType!lngVoucherNoAccountID1)
            End If
            If recType!lngVoucherNoAccountID2 > 0 Then
                lngNo2 = recType!lngVoucherNoAccountID2
                strNo2 = AccountCode(recType!lngVoucherNoAccountID2)
            End If
        End If
        recType.Close
        Set recType = Nothing
        
        If Not VoucherData.IsError And VoucherData.Used Then
            For lngCount = 0 To UBound(VoucherData.Detail)
                With VoucherData.Detail(lngCount)
                    '借方必有
                    If strDebit1 <> "" And .Direction = adDebit Then
                        If InStr(AccountCode(.AccountID), strDebit1) = 1 Then
                            strDebit1 = ""
                            strDebit2 = ""
                        End If
                    End If
                    If strDebit2 <> "" And .Direction = adDebit Then
                        If InStr(AccountCode(.AccountID), strDebit2) = 1 Then
                            strDebit1 = ""
                            strDebit2 = ""
                        End If
                    End If
                    '贷方必有
                    If strCredit1 <> "" And .Direction = adCredit Then
                        If InStr(AccountCode(.AccountID), strCredit1) = 1 Then
                            strCredit1 = ""
                            strCredit2 = ""
                        End If
                    End If
                    If strCredit2 <> "" And .Direction = adCredit Then
                        If InStr(AccountCode(.AccountID), strCredit2) = 1 Then
                            strCredit1 = ""
                            strCredit2 = ""
                        End If
                    End If
                    '凭证必有
                    If strMust1 <> "" Then
                        If InStr(AccountCode(.AccountID), strMust1) = 1 Then
                            strMust1 = ""
                            strMust2 = ""
                        End If
                    End If
                    If strMust2 <> "" Then
                        If InStr(AccountCode(.AccountID), strMust2) = 1 Then
                            strMust1 = ""
                            strMust2 = ""
                        End If
                    End If
                    '凭证必无
                    If lngNo1 > 0 Then
                        If InStr(AccountCode(.AccountID), strNo1) = 1 Then
                            lngNo1 = -1
                        End If
                    End If
                    If lngNo2 > 0 Then
                        If InStr(AccountCode(.AccountID), strNo2) = 1 Then
                            lngNo2 = -1
                        End If
                    End If
                End With
            Next lngCount
        End If
        
        '借方必有
        If strDebit1 <> "" Then
            VoucherData.ErrorString = "借方必有科目：" & strDebit1
            If strDebit2 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strDebit2
            End If
            VoucherData.IsError = True
        End If
        If strDebit2 <> "" And Not VoucherData.IsError Then
            VoucherData.ErrorString = "借方必有科目：" & strDebit2
            If strDebit1 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strDebit1
            End If
            VoucherData.IsError = True
        End If
        '贷方必有
        If strCredit1 <> "" And Not VoucherData.IsError Then
            VoucherData.ErrorString = "贷方必有科目：" & strCredit1
            If strCredit2 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strCredit2
            End If
            VoucherData.IsError = True
        End If
        If strCredit2 <> "" And Not VoucherData.IsError Then
            VoucherData.ErrorString = "贷方必有科目：" & strCredit2
            If strCredit1 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strCredit1
            End If
            VoucherData.IsError = True
        End If
        '凭证必有
        If strMust1 <> "" And Not VoucherData.IsError Then
            VoucherData.ErrorString = "凭证必有科目：" & strMust1
            If strMust2 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strMust2
            End If
            VoucherData.IsError = True
        End If
        If strMust2 <> "" And Not VoucherData.IsError Then
            VoucherData.ErrorString = "凭证必有科目：" & strMust2
            If strMust1 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strMust1
            End If
            VoucherData.IsError = True
        End If
        '凭证必无
        If lngNo1 < 0 And Not VoucherData.IsError Then
            VoucherData.ErrorString = "凭证不能有科目：" & strNo1
            If strNo2 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strNo2
            End If
            VoucherData.IsError = True
        End If
        If lngNo2 < 0 And Not VoucherData.IsError Then
            VoucherData.ErrorString = "凭证不能有科目：" & strNo2
            If strNo1 <> "" Then
                VoucherData.ErrorString = VoucherData.ErrorString & " " & strNo1
            End If
            VoucherData.IsError = True
        End If
    End If
End Sub

Public Sub CopyVoucher(VoucherData() As VoucherRecord, lngSourCnt As Long, lngDestCnt As Long)
    Dim lngCnt As Long