frmend.frm

金算盘软件代码

'第二步：结帐报告合法检查
Private Function ValidReport(Msg As String) As Boolean
    ValidReport = True
End Function

'第三步：执行结帐合法检查
Private Function ValidOver(Msg As String) As Boolean
    ValidOver = True
End Function


'''''''''''''''''''''''''''''''''''
'      会计期间其他方法
'
'''''''''''''''''''''''''''''''''''
Private Sub msgPeriod_RowColChange()
    With msgPeriod
        If .Row > 0 Then
            lblPeriod.Caption = .TextMatrix(.Row, 1)
        Else
            lblPeriod.Caption = ""
        End If
    End With
End Sub



'''''''''''''''''''''''''''''''''''
'      结帐报告他方法
'
'''''''''''''''''''''''''''''''''''
'工业企业：经营情况数据(资产、负债及权益)
Private Sub GetFactary(strFirstNote As String, strSecondNote As String, _
    strFirstNum As String, strSecondNum As String, dblFirstNum As Double, dblSecondNum As Double)
    Dim strSql As String
    Dim recBalance As rdoResultset
    Dim qrfBalance As rdoQuery
    Dim dblAsset As Double, dblLiability As Double
    Dim dblGain As Double, dblCost As Double, dblLoss As Double
    Dim strQAccountBalanceSql As String, strTmp As String
    
    strFirstNote = "资产+成本"
    strSecondNote = "负债+权益+损益"
    strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
    strSql = "SELECT Account.lngAccountTypeID,SUM((dblPostedDebit-dblPostedCredit)) AS dblAmount " _
        & "FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
        & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) " _
        & "GROUP BY Account.lngAccountTypeID"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recBalance
        If Not .EOF Then
            Do While Not .EOF
                Select Case !lngAccountTypeID
                Case atAsset
                    dblAsset = dblAsset + !dblAmount
                Case atLiability
                    dblLiability = dblLiability - !dblAmount
                Case atGain
                    dblGain = dblGain - !dblAmount
                Case atCost
                    dblCost = dblCost + !dblAmount
                Case atLoss
                    dblLoss = dblLoss - !dblAmount
                End Select
                .MoveNext
            Loop
        End If
    End With
    recBalance.Close
    Set recBalance = Nothing
    
    strFirstNum = Format(dblAsset + dblCost, "#,0.00")
    strSecondNum = Format(dblLiability + dblGain + dblLoss, "#,0.00")
    dblFirstNum = AdjustDec(dblAsset + dblCost, gclsBase.NaturalCurDec)
    dblSecondNum = AdjustDec(dblLiability + dblGain + dblLoss, gclsBase.NaturalCurDec)
End Sub
    
'企业经营利润
Private Function GetGain() As String
    Dim strSql As String
    Dim recGain As rdoResultset
    Dim strQEndGainSql As String
    
    strQEndGainSql = TransferPublic.getQEndGainOraSql
    strSql = strQEndGainSql
    strSql = Salary.Change_Text("[Year]", mintYear, strSql)
    strSql = Salary.Change_Text("[Period]", mintPeriod, strSql)
    Set recGain = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recGain.EOF Then
        If recGain!dblAmount > 0 Then
            GetGain = "经营结果(盈利) = " & Format(recGain!dblAmount, "#,0.00;#,0.00;#,0.00;#,0.00")
        Else
            If recGain!dblAmount < 0 Then
                GetGain = "经营结果(亏损) = " & Format(recGain!dblAmount, "#,0.00;#,0.00;#,0.00;#,0.00")
            Else
                GetGain = "经营结果 = 0.00"
            End If
        End If
    End If
    recGain.Close
    Set recGain = Nothing
End Function

'事业单位：企业经营情况数据(资产、支出、负债、净资产、收入)
Private Sub GetManage(strFirstNote As String, strSecondNote As String, _
    strFirstNum As String, strSecondNum As String, dblFirstNum As Double, dblSecondNum As Double)
    Dim strSql As String
    Dim qrfBalance As rdoQuery
    Dim recBalance As rdoResultset
    Dim dblAsset As Double, dblPayOut As Double
    Dim dblLiability As Double, dblNetAsset As Double, dblReceive As Double
    Dim strQAccountBalanceSql As String, strTmp As String
    
    strFirstNote = "资产+支出"
    strSecondNote = "负债+净资产+收入"
    strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
    strSql = "SELECT Account.lngAccountTypeID,SUM((dblPostedDebit-dblPostedCredit)) AS dblAmount " _
        & " FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
        & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) " _
        & "GROUP BY Account.lngAccountTypeID"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recBalance
        If Not .EOF Then
            Do While Not .EOF
                Select Case !lngAccountTypeID
                Case atAsset
                    dblAsset = dblAsset + !dblAmount
                Case atCost
                    dblReceive = dblReceive - !dblAmount
                Case atLiability
                    dblLiability = dblLiability - !dblAmount
                Case atGain
                    dblNetAsset = dblNetAsset - !dblAmount
                Case atLoss
                    dblPayOut = dblPayOut + !dblAmount
                End Select
                .MoveNext
            Loop
        End If
    End With
    recBalance.Close
    Set recBalance = Nothing
    
    strFirstNum = Format(dblAsset + dblPayOut, "#,0.00")
    strSecondNum = Format(dblLiability + dblNetAsset + dblReceive, "#,0.00")
    dblFirstNum = AdjustDec(dblAsset + dblPayOut, gclsBase.NaturalCurDec)
    dblSecondNum = AdjustDec(dblLiability + dblNetAsset + dblReceive, gclsBase.NaturalCurDec)
End Sub

'行政单位：企业经营情况数据(资产、支出、负债、净资产、收入)
Private Sub GetAdministor(strFirstNote As String, strSecondNote As String, _
    strFirstNum As String, strSecondNum As String, dblFirstNum As Double, dblSecondNum As Double)
    Dim strSql As String
    Dim qrfBalance As rdoQuery
    Dim recBalance As rdoResultset
    Dim dblAsset As Double, dblPayOut As Double
    Dim dblLiability As Double, dblNetAsset As Double, dblReceive As Double
    Dim strQAccountBalanceSql As String, strTmp As String
    
    strFirstNote = "资产+支出"
    strSecondNote = "负债+净资产+收入"
    strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
    strSql = "SELECT Account.lngAccountTypeID,SUM((dblPostedDebit-dblPostedCredit)) AS dblAmount " _
        & " FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
        & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) " _
        & "GROUP BY Account.lngAccountTypeID"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recBalance
        If Not .EOF Then
            Do While Not .EOF
                Select Case !lngAccountTypeID
                Case atAsset
                    dblAsset = dblAsset + !dblAmount
                Case atCost
                    dblReceive = dblReceive - !dblAmount
                Case atLiability
                    dblLiability = dblLiability - !dblAmount
                Case atGain
                    dblNetAsset = dblNetAsset - !dblAmount
                Case atLoss
                    dblPayOut = dblPayOut + !dblAmount
                End Select
                .MoveNext
            Loop
        End If
    End With
    recBalance.Close
    Set recBalance = Nothing
    
    strFirstNum = Format(dblAsset + dblPayOut, "#,0.00")
    strSecondNum = Format(dblLiability + dblNetAsset + dblReceive, "#,0.00")
    dblFirstNum = AdjustDec(dblAsset + dblPayOut, gclsBase.NaturalCurDec)
    dblSecondNum = AdjustDec(dblLiability + dblNetAsset + dblReceive, gclsBase.NaturalCurDec)
End Sub

'医疗：医疗经营情况数据(资产、负债、净资产+收支)
Private Sub GetPrivate(strFirstNote As String, strSecondNote As String, _
    strFirstNum As String, strSecondNum As String, dblFirstNum As Double, dblSecondNum As Double)
    Dim strSql As String
    Dim qrfBalance As rdoQuery
    Dim recBalance As rdoResultset
    Dim dblAsset As Double, dblPayOut As Double
    Dim dblLiability As Double, dblNetAsset As Double, dblGain As Double, dblCost As Double
    Dim strQAccountBalanceSql As String, strTmp As String
    
    strFirstNote = "资产"
    strSecondNote = "负债+净资产+收支"
    strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
    strSql = "SELECT Account.lngAccountTypeID,SUM((dblPostedDebit-dblPostedCredit)) AS dblAmount " _
        & "FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
        & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) " _
        & "GROUP BY Account.lngAccountTypeID"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recBalance
        If Not .EOF Then
            Do While Not .EOF
                Select Case !lngAccountTypeID
                Case atAsset
                    dblAsset = dblAsset + !dblAmount
                Case atLiability
                    dblLiability = dblLiability - !dblAmount
                Case atGain
                    dblGain = dblGain - !dblAmount
                Case atCost
                    dblCost = dblCost - !dblAmount
                End Select
                .MoveNext
            Loop
        End If
    End With
    recBalance.Close
    Set recBalance = Nothing
    
    strFirstNum = Format(dblAsset, "#,0.00")
    strSecondNum = Format(dblLiability + dblGain + dblCost, "#,0.00")
    dblFirstNum = AdjustDec(dblAsset, gclsBase.NaturalCurDec)
    dblSecondNum = AdjustDec(dblLiability + dblGain + dblCost, gclsBase.NaturalCurDec)
End Sub

'凭证缺号字符串
Private Function GetVoucherLostNo(lngLen As Long) As String
    Dim strSql As String
    Dim recVoucher As rdoResultset
    Dim lngNum As Long, strType As String, lngNo As Long
    Dim lngLostNum As Long, strLostNo As String
    Dim lngVoidNum As Long, strVoidNo As String
    
    strSql = "SELECT strVoucherTypeCode,intVoucherNO,blnIsVoid FROM Voucher " _
        & " ,VoucherType WHERE Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID " _
        & " AND intYear=" & mintYear & " AND bytPeriod=" & mintPeriod _
        & " ORDER BY 1,2"
    Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recVoucher.EOF Then strType = recVoucher!strVoucherTypeCode
    lngNo = 0
    With recVoucher
        Do While Not .EOF
            lngNum = lngNum + 1
            If strType = !strVoucherTypeCode Then
                If lngNo + 1 < !intVoucherNO Then
                    If !intVoucherNO - lngNo = 2 Then
                        strLostNo = strLostNo & "," & !strVoucherTypeCode & "-" & !intVoucherNO - 1
                        lngNum = lngNum + 1
                    Else
                        strLostNo = strLostNo & "," & !strVoucherTypeCode & "-" & lngNo + 1 & "～" & !intVoucherNO - 1
                    End If
                    lngLostNum = lngLostNum + (!intVoucherNO - lngNo - 1)
                End If
            Else
                strType = !strVoucherTypeCode
                If !intVoucherNO > 1 Then
                    If !intVoucherNO = 2 Then
                        strLostNo = strLostNo & "," & !strVoucherTypeCode & "-" & !intVoucherNO - 1
                    Else
                        strLostNo = strLostNo & "," & !strVoucherTypeCode & "-1～" & !intVoucherNO - 1
                    End If
                    lngLostNum = lngLostNum + (!intVoucherNO - 1)
                End If
            End If
            If !blnIsVoid Then
                strVoidNo = strVoidNo & "," & !strVoucherTypeCode & "-" & !intVoucherNO
                lngVoidNum = lngVoidNum + 1
            End If
            lngNo = !intVoucherNO
            .MoveNext
        Loop
    End With
    recVoucher.Close
    Set recVoucher = Nothing
    
    GetVoucherLostNo = "记帐凭证共" & lngNum & "张。"
    If lngLostNum > 0 Then
        If Len(strLostNo) < 1000 Then
            GetVoucherLostNo = GetVoucherLostNo & "缺号" & lngLostNum & "张：" & Mid(strLostNo, 2, Len(strLostNo))
        Else
            GetVoucherLostNo = GetVoucherLostNo & "缺号" & lngLostNum & "张"
        End If
    End If
    If lngVoidNum > 0 Then
        GetVoucherLostNo = GetVoucherLostNo & Chr(13) & Chr(10) & "    其中,作废凭证" & lngVoidNum _
            & "张：" & Mid(strVoidNo, 2, Len(strVoidNo))
    End If
End Function