frmac_balanceresult.frm

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

Public Property Let ubIncludeNotRecordVoucher(ByVal bIncludeNotRecordVoucher As Boolean)
    m_bIncludeNotRecordVoucher = bIncludeNotRecordVoucher
End Property
'是否包括未记账凭证
Public Property Let ubIncludeBlankKm(ByVal bIncludeBlankKm As Boolean)
    m_bIncludeBlankKm = bIncludeBlankKm
End Property

Public Sub uPreview()
    Dim i As Integer
    mIsPrint = True
    i = Cllr.GetCurSheet
    SetGrid i + 1, Cllr.GetRows(i) - 1
    Cllr.PrintPreview 1, Cllr.GetCurSheet
    mIsPrint = False
    SetGrid i + 1, Cllr.GetRows(i) - 1
    If Cllr.SaveFile(App.Path & "\CellFiles\Balance.cll", 1) = 0 Then
       MsgBox "CELL文件保存失败！", vbOKOnly
    End If
    
End Sub

Public Sub uPrint()
    Dim frmPage As frmPageSet
    Dim lTotalPages As Long, i As Long
    Dim j As Integer
    lTotalPages = Cllr.GetTotalSheets
    Set frmPage = New frmPageSet
    With frmPage
        .uiMaxPage = lTotalPages
        .uiPresentPage = Cllr.GetCurSheet + 1
        .Show 1
        If .Ok Then
            For i = .uiFromPage To .uiToPage
                If Not .uiSzFsSet Then
                  MsgBox "请插入纸张...", vbInformation
                End If
                mIsPrint = True
                SetGrid i, Cllr.GetRows(i - 1) - 1
                Cllr.SetCurSheet i - 1
                Cllr.PrintSheet 0, i - 1
                mIsPrint = False
                SetGrid i, Cllr.GetRows(i - 1) - 1
            Next i
        End If
    End With
    Unload frmPage
End Sub

'账页格式被改变时触发
Private Sub cboAccountFormat_Click()
    Dim sOldAccountFormat As String     '账页原先格式
    
    If Not m_bFormLoad Then
        sOldAccountFormat = usAccountFormat
        usAccountFormat = cboAccountFormat.List(cboAccountFormat.ListIndex)
        If IsColChange(Me.Cllr, m_iColWidth) = True Then
            If MsgBox(sOldAccountFormat & "余额表格式已经改变，是否保存？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
                Call SaveColChange(m_iColWidth, usAccountType, sOldAccountFormat)
            End If
        End If
        Select Case usAccountFormat
            Case "金额式"
                m_sDefaultColWidth = COLWIDTH_MONEY
            Case "数量金额式"
                m_sDefaultColWidth = COLWIDTH_AMOUNT
            Case "外币金额式"
                m_sDefaultColWidth = COLWIDTH_FOREIGN
            Case "数量外币式"
                m_sDefaultColWidth = COLWIDTH_AMOUNT_FOREIGN
        End Select
        m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
        m_iColWidthTemp = m_iColWidth
        
        Select Case usAccountFormat
            Case "金额式"
                Call DoRedrawCellHeadDefault(m_iColWidth)
            Case "数量金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_BEGIN_BALANCE_AMOUNT, COL_BEGIN_BALANCE_MONEY, _
                        COL_HAPPEN_DEBIT_AMOUNT, COL_HAPPEN_DEBIT_MONEY, _
                        COL_HAPPEN_CREDIT_AMOUNT, COL_HAPPEN_CREDIT_MONEY, _
                        COL_TOTAL_DEBIT_AMOUNT, COL_TOTAL_DEBIT_MONEY, _
                        COL_TOTAL_CREDIT_AMOUNT, COL_TOTAL_CREDIT_MONEY, _
                        COL_END_BALANCE_AMOUNT, COL_END_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "外币金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_BEGIN_BALANCE_FOREIGN, COL_BEGIN_BALANCE_MONEY, _
                        COL_HAPPEN_DEBIT_FOREIGN, COL_HAPPEN_DEBIT_MONEY, _
                        COL_HAPPEN_CREDIT_FOREIGN, COL_HAPPEN_CREDIT_MONEY, _
                        COL_TOTAL_DEBIT_FOREIGN, COL_TOTAL_DEBIT_MONEY, _
                        COL_TOTAL_CREDIT_FOREIGN, COL_TOTAL_CREDIT_MONEY, _
                        COL_END_BALANCE_FOREIGN, COL_END_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "数量外币式"
                Call DoRedrawCellHead(m_iColWidth, COL_BEGIN_BALANCE_AMOUNT, COL_BEGIN_BALANCE_MONEY, _
                        COL_HAPPEN_DEBIT_AMOUNT, COL_HAPPEN_DEBIT_MONEY, _
                        COL_HAPPEN_CREDIT_AMOUNT, COL_HAPPEN_CREDIT_MONEY, _
                        COL_TOTAL_DEBIT_AMOUNT, COL_TOTAL_DEBIT_MONEY, _
                        COL_TOTAL_CREDIT_AMOUNT, COL_TOTAL_CREDIT_MONEY, _
                        COL_END_BALANCE_AMOUNT, COL_END_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
        End Select
    End If
End Sub

'调整列宽时触发
Private Sub Cllr_AllowSizeCol(ByVal col As Long, ByVal row As Long, approve As Long)
    Dim vCurColWidth As Variant
    Dim lCurChangeCol As Long
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim bChangeColWidth As Boolean
    Dim i As Long
    Dim j As Long
    
    Select Case usAccountFormat
        Case "金额式"
            If col = COL_BEGIN_DIRECTION Or col = COL_BEGIN_BALANCE_MONEY Or _
                col = COL_BEGIN_BALANCE_AMOUNT Or col = COL_BEGIN_BALANCE_FOREIGN Or _
                col = COL_HAPPEN_DEBIT_AMOUNT Or col = COL_HAPPEN_DEBIT_FOREIGN Or _
                col = COL_HAPPEN_CREDIT_AMOUNT Or col = COL_HAPPEN_CREDIT_FOREIGN Or _
                col = COL_TOTAL_DEBIT_AMOUNT Or col = COL_TOTAL_DEBIT_FOREIGN Or _
                col = COL_TOTAL_CREDIT_AMOUNT Or col = COL_TOTAL_CREDIT_FOREIGN Or _
                col = COL_END_BALANCE_AMOUNT Or col = COL_END_BALANCE_FOREIGN Or _
                col = COL_END_DIRECTION Or col = COL_END_BALANCE_MONEY Then
                approve = False
            Else
                approve = True
            End If
        Case "数量金额式"
            If col = COL_BEGIN_DEBIT_MONEY Or col = COL_BEGIN_CREDIT_MONEY Or _
                col = COL_BEGIN_BALANCE_FOREIGN Or col = COL_HAPPEN_DEBIT_FOREIGN Or _
                col = COL_HAPPEN_CREDIT_FOREIGN Or col = COL_TOTAL_DEBIT_FOREIGN Or _
                col = COL_TOTAL_CREDIT_FOREIGN Or col = COL_END_BALANCE_FOREIGN Or _
                col = COL_END_DEBIT_MONEY Or col = COL_END_CREDIT_MONEY Then
                approve = False
            Else
                approve = True
            End If
        Case "外币金额式"
            If col = COL_BEGIN_DEBIT_MONEY Or col = COL_BEGIN_CREDIT_MONEY Or _
                col = COL_BEGIN_BALANCE_AMOUNT Or col = COL_HAPPEN_DEBIT_AMOUNT Or _
                col = COL_HAPPEN_CREDIT_AMOUNT Or col = COL_TOTAL_DEBIT_AMOUNT Or _
                col = COL_TOTAL_CREDIT_AMOUNT Or col = COL_END_BALANCE_AMOUNT Or _
                col = COL_END_DEBIT_MONEY Or col = COL_END_CREDIT_MONEY Then
                approve = False
            Else
                approve = True
            End If
        Case "数量外币式"
            If col = COL_BEGIN_DEBIT_MONEY Or col = COL_BEGIN_CREDIT_MONEY Or _
                col = COL_END_DEBIT_MONEY Or col = COL_END_CREDIT_MONEY Then
                approve = False
            Else
                approve = True
            End If
    End Select
    If col = COL_END + 1 Then
        approve = False
    End If
    
    For i = LBound(m_iColWidthTemp) To UBound(m_iColWidthTemp)
    vCurColWidth = Cllr.GetColWidth(1, i, Cllr.GetCurSheet)
        If vCurColWidth <> "" Then
            If vCurColWidth <> m_iColWidthTemp(i) Then
                bChangeColWidth = True
                m_iColWidthTemp(i) = vCurColWidth
                lCurChangeCol = i
            End If
        End If
    Next i

    With Cllr
        If bChangeColWidth Then
            lCurrentPage = .GetCurSheet
            iTotalPages = .GetTotalSheets
            For i = 0 To iTotalPages - 1
                .SetCurSheet i
                .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol, i
            Next i
            .SetCurSheet lCurrentPage
        End If
    End With
End Sub

'调整行高时触发
Private Sub cllR_allowsizerow(ByVal col As Long, ByVal row As Long, approve As Long)
    approve = False
End Sub

Private Sub cllR_mousedclick(ByVal col As Long, ByVal row As Long)
    Dim frmR As frmAC_DetailResult
    Dim frmD As frmAC_BookResult
    Dim mxkmdm As Variant
    Dim i As Integer
    Dim rstRec As New ADODB.Recordset
    Dim bRjz As Boolean
    Dim sSQL As String
    
    mxkmdm = Cllr.GetCellString(1, row, Cllr.GetCurSheet)
    
    If mxkmdm <> "" Then
        '当所在行在本月合计和本年累计时, 调用明细账查询
                sSQL = "select isRjz from tzw_km" & glo.sOperateYear & " where kmdm='" & Trim(mxkmdm) & "'"
                With rstRec
                   .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
                   If Not (.EOF And .BOF) Then
                     bRjz = .Fields("isrjz").value
                   End If
                   .Close
                End With
                Set rstRec = Nothing
                
                If bRjz Then
                    Set frmD = New frmAC_BookResult
                    frmD.usYear = glo.sOperateYear
                    frmD.usFromMonth = Format(m_sMonthFrom, "00")
                    frmD.usToMonth = Format(m_sMonthTo, "00")
                    frmD.usFromDate = GetPeriodFrom(CInt(m_sMonthFrom))
                    frmD.usToDate = GetPeriodTo(CInt(m_sMonthFrom))
                    frmD.usSubjectCode = mxkmdm
                   frmD.usSubjectName = GetKmmc(mxkmdm)
                    frmD.usSubjectIndex = -1
                    frmD.usIncludeNotRecord = True
                    
                   ' If m_bIncludeNotRecord Then
                        frmD.usIncludeNotRecord = True
'                    Else
'                        frmD.usIncludeNotRecord = False
'                    End If
                    frmD.ShowResult
               Else
                    Set frmR = New frmAC_DetailResult
                    frmR.usYear = glo.sOperateYear
                    frmR.usFromMonth = Format(m_sMonthFrom, "00")
                    frmR.usToMonth = Format(m_sMonthTo, "00")
                    frmR.usSubjectCodeStart = mxkmdm
                    frmR.usSubjectNameStart = GetKmmc(mxkmdm)
                   ' frmR.usNRFlag = m_bIncludeNotRecord
                   frmR.usNRFlag = True
                    frmR.usSubjectCodeEnd = mxkmdm
                   frmR.usSubjectCurName = GetKmmc(mxkmdm)
                    frmR.ubBlankKm = False
                    frmR.Kmmc_set1
                    frmR.Tag = mxkmdm & "," & Format(Month(m_sMonthFrom), "00")
'                    If m_bIncludeNotRecord Then
'                       frmR.ShowResultbak
'                    Else
                       frmR.ShowResult
                    'End If
             End If
           End If
      'End If
'  End If
End Sub

Private Sub cllR_MouseRClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
PopupMenu fMainForm.mnuPopupMenu
End Sub



Private Sub Form_Activate()
TbrControl False
End Sub

Private Sub Form_Deactivate()
TbrControl True