frmac_generalresult.frm

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

                Cllr.SetCellSeparator COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 2

    Next i
            
    '求年初余额(期初余额)
     dBalance_Amount = tMonthLj(m_iFromMonth - 1).dDebit_Amount - tMonthLj(m_iFromMonth - 1).dCredit_Amount
     dBalance_Foreign = tMonthLj(m_iFromMonth - 1).dDebit_Foreign - tMonthLj(m_iFromMonth - 1).dCredit_Foreign
     dBalance_Money = tMonthLj(m_iFromMonth - 1).dDebit_Money - tMonthLj(m_iFromMonth - 1).dCredit_Money
    If dBalance_Money > 0 Then
        sDireciton = "借"
    ElseIf dBalance_Money = 0 Then
        sDireciton = "平"
    Else
        sDireciton = "贷"
        '此时dBlance_Money小于零;
        '如果dBalance_Amount(或者dBalance_Foreign)等于 -dBalance_Amount(或者 - dBalance_Foreign)
        dBalance_Amount = -dBalance_Amount
        dBalance_Foreign = -dBalance_Foreign
    End If
    i = ROW_GRID_START
    
    StartDate = CDate(GetPeriodFrom(m_iFromMonth))
    Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, Month(StartDate)
    Cllr.SetCellString COL_DAY, i, Cllr.GetCurSheet, Day(StartDate)
    Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, IIf(m_iFromMonth = 1, "[ 上  年  结  转 ]", "[ 期  初  余  额 ]")
    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
    
    '从年(期)初月份到十二月份,求出当前输入科目的累计余额；
    For k = m_iFromMonth To m_iToMonth
        '求本期合计
        i = i + 1
        dDebit_Amount = tMonthLj(k).dDebit_Amount - tMonthLj(k - 1).dDebit_Amount
        dDebit_Foreign = tMonthLj(k).dDebit_Foreign - tMonthLj(k - 1).dDebit_Foreign
        dDebit_Money = tMonthLj(k).dDebit_Money - tMonthLj(k - 1).dDebit_Money
                       
        dCredit_Amount = tMonthLj(k).dCredit_Amount - tMonthLj(k - 1).dCredit_Amount
        dCredit_Foreign = tMonthLj(k).dCredit_Foreign - tMonthLj(k - 1).dCredit_Foreign
        dCredit_Money = tMonthLj(k).dCredit_Money - tMonthLj(k - 1).dCredit_Money
                        
        '求出本年累计余额
        dBalance_Amount = tMonthLj(k).dDebit_Amount - tMonthLj(k).dCredit_Amount
        dBalance_Foreign = tMonthLj(k).dDebit_Foreign - tMonthLj(k).dCredit_Foreign
        dBalance_Money = tMonthLj(k).dDebit_Money - tMonthLj(k).dCredit_Money
                
        If dBalance_Money > 0 Then
            sDireciton = "借"
        ElseIf dBalance_Money = 0 Then
            sDireciton = "平"
        Else
            sDireciton = "贷"
            dBalance_Amount = -dBalance_Amount
            dBalance_Foreign = -dBalance_Foreign
        End If
        StartDate = CDate(GetPeriodTo(k))
        Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, Month(StartDate)
'        CllR.SetCellString COL_DAY, i, CllR.GetCurSheet, Day(StartDate)
        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 = tMonthLj(k).dDebit_Amount - tMonthLj(0).dDebit_Amount
        dDebit_Foreign = tMonthLj(k).dDebit_Foreign - tMonthLj(0).dDebit_Foreign
        dDebit_Money = tMonthLj(k).dDebit_Money - tMonthLj(0).dDebit_Money
        
        dCredit_Amount = tMonthLj(k).dCredit_Amount - tMonthLj(0).dCredit_Amount
        dCredit_Foreign = tMonthLj(k).dCredit_Foreign - tMonthLj(0).dCredit_Foreign
        dCredit_Money = tMonthLj(k).dCredit_Money - tMonthLj(0).dCredit_Money
        
        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
        If maxKjqj = CInt(tMonthLj(k).sKjqj) Then
           Exit For
        End If
    Next k
    Call SetGrid
    Cllr.Visible = True
    For i = 1 To Cllr.GetTotalSheets
       Cllr.SetSheetLabel i - 1, "第" & i & "页"
    Next i
    
    '为了防止装填账页格式时触发cboaccountformat_click事件时，出现系统提示账页格式已改变；
    '所以将此程序在此调用
    Call SetAccountFormat(cboAccountFormat, m_bAmount, m_bForeign)
    fMainForm.MousePointer = vbDefault
    Me.Show


'err_handle:
'    MsgBox "请重新选择科目", vbOKOnly
  
End Sub

'从凭证表中求出会计期间等于(结账月份+1)的已记账凭证的记录数;
'如果iToMonth = 0 则判断年初1月份已记账凭证的记录数;
Private Function GetToMonth(ByVal iToMonth As Integer) As Integer
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open "SELECT COUNT(*) iCount FROM tZW_Pzsj" & glo.sOperateYear & _
                " WHERE kjqj = " & iToMonth + 1 & " AND xgbz='2'", _
                glo.cnnMain, adOpenStatic, adLockReadOnly
        If .Fields("iCount").value = 0 Then
            GetToMonth = iToMonth
        Else
            GetToMonth = iToMonth + 1
        End If
    End With
    Set rstTemp = Nothing
   
End Function

'根据选择的账页格式重画表格的页头
Private Sub DoRedrawCellHead(ByVal iColWidth As Variant, _
                            ByVal Col_Debit_Start As Integer, ByVal Col_Debit_End As Integer, _
                            ByVal Col_Credit_Start As Integer, ByVal Col_Credit_End As Integer, _
                            ByVal Col_Balance_Start As Integer, ByVal COL_BALANCE_END As Integer, _
                            ByVal Row_Start As Integer, ByVal Row_End As Integer)
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim i As Integer
    Dim j As Integer
    
    With Cllr
        iTotalPages = .GetTotalSheets
        lCurrentPage = .GetCurSheet
        For i = 0 To iTotalPages
            .SetCurSheet i
            For j = LBound(iColWidth) To UBound(iColWidth)
                .SetColWidth 1, iColWidth(j), j, i
            Next j
            
            .MergeCells Col_Debit_Start, Row_Start, Col_Debit_End, Row_End
            .MergeCells Col_Credit_Start, Row_Start, Col_Credit_End, Row_End
            .MergeCells Col_Balance_Start, Row_Start, COL_BALANCE_END, Row_End
            
            .SetCellString Col_Debit_Start, ROW_HEAD1, i, "借方"
            .SetCellString Col_Credit_Start, ROW_HEAD1, i, "贷方"
            .SetCellString Col_Balance_Start, ROW_HEAD1, i, "余额"
            .SetCellString COL_DEBIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_DEBIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_DEBIT_MONEY, ROW_HEAD2, i, "金额"
            .SetCellString COL_CREDIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_CREDIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_CREDIT_MONEY, ROW_HEAD2, i, "金额"
            .SetCellString COL_BALANCE_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_BALANCE_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_BALANCE_MONEY, ROW_HEAD2, i, "金额"
        Next i
        .SetCurSheet lCurrentPage
    End With
End Sub
Public Function Kmmc_set() As Boolean
   '设置科目代码数组
   
   Dim temp_code As String
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim m As Integer
   Dim n As Integer
   Dim iCount As Integer
   Dim iTemp As Integer
   Dim iLenStart As Integer
   Dim iLenEnd As Integer
   Dim sTemp As String
   
     
    ReDim arySubDetail(0 To 0)
    j = 1
    
    '开始和终止代码都为空
    If m_sSubjectCodeStart = "" And m_sSubjectCodeEnd = "" Then
       sTemp = ""
       Call GetDetailKm(sTemp)
       If bDetailFlag Then
          For i = LBound(arySubject) To UBound(arySubject)
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  j = j + 1
          Next i
          Kmmc_set = True
       Else
          Kmmc_set = False
       End If
       Exit Function
    End If
    
   '开始科目为空和终止代码非空
   If m_sSubjectCodeStart <> "" And m_sSubjectCodeEnd = "" Then
       sTemp = m_sSubjectCodeStart
       Call GetDetailKm(sTemp)
       If bDetailFlag Then
          For i = LBound(arySubject) To UBound(arySubject)
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  j = j + 1
          Next i
          Kmmc_set = True
       Else
          Kmmc_set = False
       End If
       Exit Function
    End If
     
   '开始科目为非空和终止代码空
    If m_sSubjectCodeStart = "" And m_sSubjectCodeEnd <> "" Then
       sTemp = ""
       Call GetDetailKm(sTemp)
       If bDetailFlag Then
          For i = LBound(arySubject) To UBound(arySubject)
             If glo.sSeparateSubject = "0" Then
                    iLenEnd = Len(m_sSubjectCodeEnd)
                    If arySub