frmac_bookresultprint.frm

一个用VB写的财务软件源码

                dBalance_Money = .Fields("ljj" & Format(k, "00")).value - _
                        .Fields("ljd" & Format(k, "00")).value
                        
                If dBalance_Money > 0 Then
                    sDireciton = "借"
                ElseIf dBalance_Money = 0 Then
                    sDireciton = "平"
                Else
                    sDireciton = "贷"
                    dBalance_Amount = -dBalance_Amount
                    dBalance_Foreign = -dBalance_Foreign
                End If

                Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, k
                Cllr.SetCellString COL_DAY, i, Cllr.GetCurSheet, Day(GetPeriodTo(k))
                Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, "[ 本  月  合  计 ]"
                
                
            If dDebit_Amount <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, dDebit_Amount
            End If
            If dDebit_Foreign <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, dDebit_Foreign
            End If
            If dDebit_Money <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_MONEY, i, Cllr.GetCurSheet, dDebit_Money
            End If
            If dCredit_Amount <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, dCredit_Amount
            End If
            If dCredit_Foreign <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, dCredit_Foreign
            End If
            If dCredit_Money <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_MONEY, i, Cllr.GetCurSheet, dCredit_Money
            End If
               '求本期合计的余额
            If dDebit_Money - dCredit_Money > 0 Then
                 sHappenDirection = "借"
            ElseIf dDebit_Money - dCredit_Money = 0 Then
                 sHappenDirection = "平"
            Else
                 sHappenDirection = "贷"
            End If
            Cllr.SetCellString COL_DIRECTION, i, Cllr.GetCurSheet, sHappenDirection
            If dDebit_Amount - dCredit_Amount <> 0 Then
                Cllr.SetCellDouble COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, Abs(dDebit_Amount - dCredit_Amount)
            End If
            If dDebit_Foreign - dCredit_Foreign <> 0 Then
               Cllr.SetCellDouble COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, Abs(dDebit_Foreign - dCredit_Foreign)
            End If
            If dDebit_Money - dCredit_Money <> 0 Then
               Cllr.SetCellDouble COL_BALANCE_MONEY, i, Cllr.GetCurSheet, Abs(dDebit_Money - dCredit_Money)
            End If
                
                '求本期累计
                i = i + 1
                dDebit_Amount = .Fields("ljjsl" & Format(k, "00")).value - .Fields("ljjsl00").value
                dDebit_Foreign = .Fields("ljjwb" & Format(k, "00")).value - .Fields("ljjwb00").value
                dDebit_Money = .Fields("ljj" & Format(k, "00")).value - .Fields("ljj00").value
                
                dCredit_Amount = .Fields("ljdsl" & Format(k, "00")).value - .Fields("ljdsl00").value
                dCredit_Foreign = .Fields("ljdwb" & Format(k, "00")).value - .Fields("ljdwb00").value
                dCredit_Money = .Fields("ljd" & Format(k, "00")).value - .Fields("ljd00").value
               
                Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, k
                Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, "[ 本  年  累  计 ]"
            If dDebit_Amount <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, dDebit_Amount
            End If
            If dDebit_Foreign <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, dDebit_Foreign
            End If
            If dDebit_Money <> 0 Then
                Cllr.SetCellDouble COL_DEBIT_MONEY, i, Cllr.GetCurSheet, dDebit_Money
            End If
            If dCredit_Amount <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, dCredit_Amount
            End If
            If dCredit_Foreign <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, dCredit_Foreign
            End If
            If dCredit_Money <> 0 Then
                Cllr.SetCellDouble COL_CREDIT_MONEY, i, Cllr.GetCurSheet, dCredit_Money
            End If
                Cllr.SetCellString COL_DIRECTION, i, Cllr.GetCurSheet, sDireciton
            If dBalance_Amount <> 0 Then
                Cllr.SetCellDouble COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, dBalance_Amount
            End If
            If dBalance_Foreign <> 0 Then
                Cllr.SetCellDouble COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, dBalance_Foreign
            End If
            If Abs(dBalance_Money) <> 0 Then
                Cllr.SetCellDouble COL_BALANCE_MONEY, i, Cllr.GetCurSheet, Abs(dBalance_Money)
            End If
            Next k
            
            Cllr.Visible = True
            For i = 1 To Cllr.GetTotalSheets
               Cllr.SetSheetLabel i - 1, "第" & i & "页"
               Call SetGrid(i, ROWS_PAGE + ROW_GRID_START + 1, iPageStart)
            Next i
            iPageStart = iPageStart + Cllr.GetTotalSheets
            ShowGeneralResult = iPageStart
            '为了防止装填账页格式时触发cboaccountformat_click事件时，出现系统提示账页格式已改变；
            '所以将此程序在此调用
'            Call SetAccountFormat(cboAccountFormat, m_bAmount, m_bForeign)
            fMainForm.MousePointer = vbDefault
'            Me.Show
        End If
        .Close
    End With
End Function


Public Function ShowResult(Optional ByVal iPageStart As Integer = 0) As Integer
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    Dim rstTotal As ADODB.Recordset
    Dim sTemp As String                 '临时存放科目代码
    Dim PreStartOfMonth As String       '查询起始月份的上一个月
    Dim PreKjqj As Integer              '当前凭证的上一条凭证记录的会计期间
    Dim CurKjqj As Integer              '当前凭证记录会计期间
    Dim PrePzrq As Date                 '当前凭证的上一条凭证记录的凭证日期
    Dim CurPzrq As Date                 '当前凭证的记录的凭证日期
    Dim sStr As String                  '查询条件子串
    Dim i As Integer
    Dim zgs As String
    Dim iTemp As Integer
    
    ShowResult = iPageStart
    '得到当前账套的单位名称
    m_sEnterName = GetDWMC
    If m_sEnterName = "" Then
        Exit Function
    End If
    
    '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
    Cllr.Visible = False

    Cllr.ResetContent
    '清除CELL控件内容后，必须重新设置CELL的行数和列数；
    Cllr.SetCols COL_END + 2, 0
    Cllr.SetRows ROW_GRID_START + ROWS_PAGE, 0
    
    fMainForm.MousePointer = vbHourglass
         
    '得到一个科目数量单位和外币单位
'    Call GetSldwAndWbdw(m_sSubjCode, m_sSldw, m_sWbdw)
    
   '得到打印时显示的科目代码和名称以及总账科目
    '得到打印时显示的科目代码和名称以及日记账科目
    If glo.bSeparateSubject Then
        m_sPrintSubjectCode = SeparateSubject(glo.sAccountID, m_sSubjCode)
    Else
        m_sPrintSubjectCode = m_sSubjCode
    End If
    m_sPrintSubjectName = GetSubjectFullPath(glo.sAccountID, m_sSubjCode)
    
    If InStr(1, m_sPrintSubjectName, "\") > 0 Then
        m_sDaySubjectName = Mid(m_sPrintSubjectName, 1, InStr(1, m_sPrintSubjectName, "\") - 1)
    Else
        m_sDaySubjectName = m_sPrintSubjectName
    End If
    Call GetSldwAndWbdw1(m_sSubjCode, m_sSldw, m_sWbdw, zgs)
    If m_sSldw <> "" Then
        m_bAmount = True
    Else
        m_bAmount = False
    End If
    If m_sWbdw <> "" Then
        m_bForeign = True
    Else
        m_bForeign = False
    End If
    
    CurRow = ROW_GRID_START - 1
    lCount = 0
    lPage = 0
    
    '查询求上月余额
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    PreStartOfMonth = Format(Val(m_sFromMonth) - 1, "00")
    sSQL = "SELECT ljjsl00 JFSL00,ljjwb00 JFWB00,ljj00 JF00," _
                & "ljdsl00 DFSL00,ljdwb00 DFWB00,ljd00 DF00," _
            & "ljjsl" & PreStartOfMonth & " JFSL01,ljjwb" & PreStartOfMonth & " JFWB01,ljj" & PreStartOfMonth & " JF01," _
            & "ljdsl" & PreStartOfMonth & " DFSL01,ljdwb" & PreStartOfMonth & " DFWB01,ljd" & PreStartOfMonth & " DF01" _
            & " FROM tZW_balance" & m_sYear _
            & " WHERE kmdm='" & m_sSubjCode & "'"
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        dYE = .Fields("JF01").value - .Fields("DF01").value
        dYESL = .Fields("JFSL01").value - .Fields("DFSL01").value
        dYEWB = .Fields("JFWB01").value - .Fields("DFWB01").value
        .Close
    End With
    
    '查询求上日余额, 不包括未复核的凭证（对于起始日饲每月一号的查询，本段实际上勿需执行）
        '在查询起始日期所在的月内，在查询起始日之前的几天的金额、数量、外币的合计
                '金额--A, 外币--B, 数量--C
                
    '加上借方
    If IsEndSubject(m_sSubjCode) Then
        Select Case g_FLAT
            Case "SQL"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >='" & glo.sUnEarlierDate & "'" & _
                        " AND pzrq <'" & m_sFromDate & "'" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm = '" & Trim(m_sSubjCode) & "'" & _
                        " AND fx='借'"
            Case "ORACLE"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >= TO_DATE('" & glo.sUnEarlierDate & "','YYYY-MM-DD')" & _
                        " AND pzrq < TO_DATE('" & m_sFromDate & "','YYYY-MM-DD')" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm ='" & Trim(m_sSubjCode) & "'" & _
                        " AND fx='借'"
        End Select
    Else
        Select Case g_FLAT
            Case "SQL"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >='" & glo.sUnEarlierDate & "'" & _
                        " AND pzrq <'" & m_sFromDate & "'" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm like '" & Trim(m_sSubjCode) & "-%'" & _
                        " AND fx='借'"
            Case "ORACLE"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >= TO_DATE('" & glo.sUnEarlierDate & "','YYYY-MM-DD')" & _
                        " AND pzrq < TO_DATE('" & m_sFromDate & "','YYYY-MM-DD')" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm like '" & Trim(m_sSubjCode) & "-%'" & _
                        " AND fx='借'"
        End Select
    End If
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .BOF And .EOF Then
        Else
            dYE = dYE + IIf(IsNull(.Fields("sumJE").value), 0, .Fields("sumJE").value)
            dYESL = dYESL + IIf(IsNull(.Fields("sumSL").value), 0, .Fields("sumSL").value)
            dYEWB = dYEWB + IIf(IsNull(.Fields("sumWB").value), 0, .Fields("sumWB").value)
        End If
        .Close
    End With
    
    '减去贷方
    If IsEndSubject(m_sSubjCode) Then
         Select Case g_FLAT
            Case "SQL"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >='" & glo.sUnEarlierDate & "'" & _
                        " AND pzrq <'" & m_sFromDate & "'" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm = '" & Trim(m_sSubjCode) & "'" & _
                        " AND fx='贷'"
            Case "ORACLE"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >= TO_DATE('" & glo.sUnEarlierDate & "','YYYY-MM-DD')" & _
                        " AND pzrq < TO_DATE('" & m_sFromDate & "','YYYY-MM-DD')" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm ='" & Trim(m_sSubjCode) & "'" & _
                        " AND fx='贷'"
        End Select
    Else
        Select Case g_FLAT
            Case "SQL"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >='" & glo.sUnEarlierDate & "'" & _
                        " AND pzrq <'" & m_sFromDate & "'" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm like '" & Trim(m_sSubjCode) & "-%'" & _
                        " AND fx='贷'"
            Case "ORACLE"
                sSQL = "SELECT sum(je) sumJE,sum(wb) sumWB,sum(sl) sumSL" & _
                        " FROM tZW_pzsj" & m_sYear & _
                        " WHERE pzrq >= TO_DATE('" & glo.sUnEarlierDate & "','YYYY-MM-DD')" & _
                        " AND pzrq < TO_DATE('" & m_sFromDate & "','YYYY-MM-DD')" & _
                        " AND  xgbz='2'" & _
                        " AND kmdm like '" & Trim(m_sSubjCode) & "-%'" & _
                        " AND fx='贷'"
        End Select
    End If
    
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .BOF And .EOF Then
        Else
            dYE = dYE - IIf(IsNull(.Fields("sumJE").value), 0, .Fields("sumJE").value)
            dYESL = dYESL - IIf(IsNull(.Fields("sumSL").value), 0, .Fields("sumSL").value)
            dYEWB = dYEWB - IIf(IsNull(.Fields("sumWB").value), 0, .Fields("sumWB").value)
        End If
        .Close
    End With
    
    If dYE > 0 Then
        sFX = "借"
    ElseIf dYE = 0 Then
        sFX = "平"
    Else
        sFX = "贷"