frmdispart.frm

金算盘软件代码

        
        fraWizard(2).Tag = "已设置"
        
        '凭证模板参照
        RefreshTemplate
        lngCnt = CLng(GetSet(1, "结余分配", "凭证摸板", 0))
        If lngCnt > 0 Then ltxtTemplate.SeekId lngCnt
        
        '凭证类型参照
        RefreshVoucherType
        lngCnt = CLng(GetSet(1, "结余分配", "凭证类型", 0))
        If lngCnt > 0 Then ltxtType.SeekId lngCnt
        
        If UBound(VoucherData) < 100 And UBound(VoucherData(0).Detail) < 100 Then
            strResult = ""
            lngLen = 58
            For lngCnt = 0 To UBound(VoucherData)
                With VoucherData(lngCnt)
                    If .Used Then
                        For lngCntOrder = 0 To UBound(.Detail)
                            lngCntDetail = lngCntOrder
                            If .Detail(lngCntDetail).Amount <> 0 Then
                                If .Detail(lngCntDetail).Direction = adDebit Then
                                    strDetail = "借："
                                Else
                                    strDetail = "贷："
                                End If
                                strSql = "SELECT strAccountCode,strAccountName FROM Account " _
                                    & "WHERE lngAccountID=" & .Detail(lngCntDetail).AccountID
                                'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                                Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If Not recAccount.EOF Then
                                    strDetail = strDetail & recAccount!strAccountCode & " " _
                                        & Trim(recAccount!strAccountName)
                                    If .Detail(lngCntDetail).CustomerID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & CustomerName(.Detail(lngCntDetail).CustomerID)
                                    End If
                                    If .Detail(lngCntDetail).DepartmentID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & DepartmentName(.Detail(lngCntDetail).DepartmentID)
                                    End If
                                    If .Detail(lngCntDetail).EmployeeID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & EmployeeName(.Detail(lngCntDetail).EmployeeID)
                                    End If
        '                            If .Detail(lngCntDetail).JobID > 0 Then
        '                                strDetail = strDetail & "/" & JobName(.Detail(lngCntDetail).JobID)
        '                            End If
                                    If .Detail(lngCntDetail).ClassID1 > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & Class1Name(.Detail(lngCntDetail).ClassID1)
                                    End If
                                    If .Detail(lngCntDetail).ClassID2 > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & Class2Name(.Detail(lngCntDetail).ClassID2)
                                    End If
                                End If
                                lngSpace = lngLen - StrLen(strDetail) - 14
                                If lngSpace < 0 Then lngSpace = 0
                                strDetail = strDetail & Space(lngSpace)
                                strAmount = Format(.Detail(lngCntDetail).Amount, "#0.00")
                                lngSpace = 14 - StrLen(strAmount)
                                If lngSpace < 0 Then lngSpace = 0
                                strDetail = strDetail & Space(lngSpace) & strAmount
                                strResult = strResult & strDetail & Chr(13) & Chr(10)
                            End If
                        Next lngCntOrder
                        strResult = strResult & String(lngLen / 2, "─") & Chr(13) & Chr(10)
                    End If
                End With
            Next lngCnt
        Else
            If UBound(VoucherData) > 0 Then
                strResult = "共有" & UBound(VoucherData) + 1 & "张凭证"
            Else
                strResult = "凭证共有" & UBound(VoucherData(0).Detail) + 1 & "笔分录"
            End If
        End If
        txtResult.Text = strResult
    End If
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  向导步骤合法检查
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步，损益科目
Private Function ValidAccount1(Msg As String) As Boolean
    Dim strSql As String
    Dim recAccount As rdoResultset
    
    ValidAccount1 = True
    If ltxtAcc11.ID = 0 Then
        ValidAccount1 = False
        Msg = "请指定收支结余科目！"
    End If
    If ValidAccount1 Then
        If ltxtAcc12.ID = 0 Then
            ValidAccount1 = False
            Msg = "财政专项补助结余科目！"
        End If
    End If
    If ValidAccount1 Then
        If ltxtAcc13.ID = 0 Then
            ValidAccount1 = False
            Msg = "待分配结余科目！"
        End If
    End If
    '生成结余转入凭证
    If ValidAccount1 Then
        ValidAccount1 = GenVoucher1
        If Not ValidAccount1 Then
          Msg = "生成结余分配凭证失败！"
       End If
    End If
    '计算结余分配科目余额(mdblBalance13)
    If ValidAccount1 Then
       ValidAccount1 = GetTotalBalance
       If Not ValidAccount1 Then
          Msg = "计算结余分配科目余额失败！"
       End If
    End If
    '科目
    If ValidAccount1 Then
        strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAcc13.ID
        'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recAccount.EOF Then
            'If Not recAccount!blnIsDetail Then
            If recAccount!blnIsDetail = 0 Then
                ValidAccount1 = False
                Msg = "科目必须是明细科目！"
            'ElseIf recAccount!blnIsCustomer Or recAccount!blnIsDepartment Or recAccount!blnIsEmployee Or _
                recAccount!blnIsClass1 Or recAccount!blnIsClass2 Or _
                recAccount!blnIsQuantity Or recAccount!blnIsMultCurrency Or recAccount!blnIsAllCurrency Then
            ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                ValidAccount1 = False
                Msg = "科目不能有辅助核算,也不能进行外币核算！"
            ElseIf recAccount!lngAccountNatureID > 0 Then
                ValidAccount1 = False
                Msg = "科目不能是现金银行、应收应付及存货类科目！"
            End If
        Else
            ValidAccount1 = False
            Msg = "科目不存在！"
        End If
        Set recAccount = Nothing
    End If
    If Not ValidAccount1 Then
        mdblBalance13 = 0
    Else
        SaveSet 1, "结余分配", "收支结余科目", ltxtAcc11.ID, True, "Long"
        SaveSet 1, "结余分配", "财政专项补助结余科目", ltxtAcc12.ID, True, "Long"
        SaveSet 1, "结余分配", "待分配结余科目", ltxtAcc13.ID, True, "Long"
    End If
    InitVoucher VoucherData(1)
    InitVoucher VoucherData(2)
    InitVoucher VoucherData(3)
    fraWizard(1).Tag = ""
    fraWizard(2).Tag = ""
    mblnValid(1) = False
    mblnValid(2) = False
End Function

'第二步，结余分配
Private Function ValidAccount2(Msg As String) As Boolean
    Dim strSql As String
    Dim recAccount As rdoResultset
    
    InitVoucher VoucherData(1)
    InitVoucher VoucherData(2)
    InitVoucher VoucherData(3)
    ValidAccount2 = True
    Select Case mdblBalance13
    Case Is > 0
        If C2Dbl(spinRate.Text) < 0 Then
            If ltxtAcc31.ID = 0 Then
                ValidAccount2 = False
                Msg = "职工福利基金比例不能小于0！"
            End If
        End If
        If ValidAccount2 Then
            If ltxtAcc31.ID = 0 Then
                ValidAccount2 = False
                Msg = "输入职工福利基金科目！"
            End If
        End If
        If ValidAccount2 Then
            If ltxtAcc32.ID = 0 Then
                ValidAccount2 = False
                Msg = "输入结余分配科目！"
            End If
        End If
        If ValidAccount2 Then
            If ltxtAcc33.ID = 0 Then
                ValidAccount2 = False
                Msg = "输入未分配结余转入科目！"
            End If
        End If
        If ValidAccount2 Then
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAcc31.ID
            'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
                'If Not recAccount!blnIsDetail Then
                If recAccount!blnIsDetail = 0 Then
                    ValidAccount2 = False
                    Msg = "职工福利基金科目必须是明细科目！"
                'ElseIf recAccount!blnIsCustomer Or recAccount!blnIsDepartment Or recAccount!blnIsEmployee Or _
                    recAccount!blnIsClass1 Or recAccount!blnIsClass2 Or _
                    recAccount!blnIsQuantity Or recAccount!blnIsMultCurrency Or recAccount!blnIsAllCurrency Then
                ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                    recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                    recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                    ValidAccount2 = False
                    Msg = "职工福利基金科目不能有辅助核算,也不能进行外币核算！"
                ElseIf recAccount!lngAccountNatureID > 0 Then
                    ValidAccount2 = False
                    Msg = "职工福利基金科目不能是现金银行、应收应付及存货类科目！"
                End If
            Else
                ValidAccount2 = False
                Msg = "科目不存在！"
            End If
        End If
        If ValidAccount2 Then
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAcc32.ID
            'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
                'If Not recAccount!blnIsDetail Then
                If recAccount!blnIsDetail = 0 Then
                    ValidAccount2 = False
                    Msg = "结余分配科目必须是明细科目！"
                'ElseIf recAccount!blnIsCustomer Or recAccount!blnIsDepartment Or recAccount!blnIsEmployee Or _
                    recAccount!blnIsClass1 Or recAccount!blnIsClass2 Or _
                    recAccount!blnIsQuantity Or recAccount!blnIsMultCurrency Or recAccount!blnIsAllCurrency Then
                ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                    recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                    recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                    ValidAccount2 = False
                    Msg = "结余分配科目不能有辅助核算,也不能进行外币核算！"
                ElseIf recAccount!lngAccountNatureID > 0 Then
                    ValidAccount2 = False
                    Msg = "结余分配科目不能是现金银行、应收应付及存货类科目！"
                End If
            Else
                ValidAccount2 = False
                Msg = "科目不存在！"
            End If
        End If
        If ValidAccount2 Then
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAcc33.ID
            'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
                'If Not recAccount!blnIsDetail Then
                If recAccount!blnIsDetail = 0 Then
                    ValidAccount2 = False
                    Msg = "未分配结余转入科目必须是明细科目！"
                'ElseIf recAccount!blnIsCustomer Or recAccount!blnIsDepartment Or recAccount!blnIsEmployee Or _
                    recAccount!blnIsClass1 Or recAccount!blnIsClass2 Or _
                    recAccount!blnIsQuantity Or recAccount!blnIsMultCurrency Or recAccount!blnIsAllCurrency Then
                ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                    recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                    recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                    ValidAccount2 = False
                    Msg = "未分配结余转入科目不能有辅助核算,也不能进行外币核算！"
                ElseIf recAccount!lngAccountNatureID > 0 Then
                    ValidAccount2 = False
                    Msg = "未分配结余转入科目不能是现金银行、应收应付及存货类科目！"
                End If
            Else
                ValidAccount2 = False
                Msg = "科目不存在！"
            End If
        End If
        Set recAccount = Nothing
        fraWizard(2).Tag = ""
        If ValidAccount2 Then
            SaveSet 1, "结余分配", "职工福利基金科目", ltxtAcc31.ID, True, "Long"
            SaveSet 1, "结余分配", "结余分配科目3", ltxtAcc32.ID, True, "Long"
            SaveSet 1, "结余分配", "未分配结余转入", ltxtAcc33.ID, True, "Long"
            SaveSet 1, "结余分配", "提取职工福利基金比例", C2Dbl(spinRate.Text), True, "Double"
        End If
        If ValidAccount2 Then
            ValidAccount2 = GenVoucher3
            If Not ValidAccount2 Then
                Msg = "提取职工福利基金凭证生成失败！"
            End If
        End If
    Case Is < 0
        If ValidAccount2 Then
            If ltxtAcc21.ID = 0 Then
                ValidAccount2 = False
                Msg = "输入弥补亏损科目！"
            End If
        End If
        If ValidAccount2 Then
            If ltxtAcc22.ID = 0 Then
                ValidAccount2 = False
                Msg = "输入结余分配科目！"
            End If
        End If
        If ValidAccount2 Then
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtAcc21.ID
            'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
                'If Not recAccount!blnIsDetail Then
                If recAccount!blnIsDetail = 0 Then
                    ValidAccount2 = False
                    Msg = "弥补亏损科目必须是明细科目！"
                'ElseIf recAccount!blnIsCustomer Or recAccount!blnIsDepartment Or recAccount!blnIsEmployee Or _
                    recAccount!blnIsClass1 Or recAccount!blnIsClass2 Or _
                    recAccount!blnIsQuantity Or recAccount!blnIsMultCurrency Or recAccount!blnIsAllCurrency Then
                ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                    recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                    recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                   ValidAccount2 = False
                    Msg = "弥补亏损科目不能有辅助核算,也不能进行外币核算！"
                ElseIf recAccount!lngAccountNatureID > 0 Then
                    ValidAccount2 = False
                    Msg = "弥补亏损科目不能是现金银行、应收应付及存货类科目！"
                End If
            Else