frmac_detailresult.frm

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

                If Not .uiSzFsSet Then
                  MsgBox "请插入纸张...", vbInformation
                End If

                Cllr.SetCurSheet i - 1
                Cllr.PrintSheet 0, i - 1
            Next i
        End If
    End With
    Unload frmPage
    
End Sub

'联查总账
Public Sub uBalanceResult()
    Dim frmR As frmAC_GeneralResult
    Dim i As Integer
    Dim bFound As Boolean       '是否总账查询窗体已经存在
    
    For i = 0 To Forms.Count - 1
        If Forms(i).Tag = m_sCurSubjectCode Then
            Forms(i).ZOrder
            bFound = True
            Exit Sub
        End If
    Next i
    
    If Not bFound Then
        Set frmR = New frmAC_GeneralResult
        frmR.usIncludeNotRecordFlag = m_bIncludeNotRecord
        frmR.usSubjectCodeStart = m_sCurSubjectCode
        frmR.usSubjectNameStart = m_sCurSubjectName
        frmR.usSubjectCodeEnd = ""
        frmR.usSubjectNameEnd = ""
        frmR.usSubjectJcFlag = True
        frmR.Tag = m_sCurSubjectCode
        frmR.Kmmc_set
        If m_bIncludeNotRecord Then
          frmR.ShowResultIncludeNotRec
        Else
          frmR.ShowResult
        End If
    End If
End Sub

'联查凭证
Public Sub uVoucherResult()
    Call cllR_mousedclick(m_iCol, m_iRow)
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 DoRedrawCellHead(m_iColWidth, COL_DEBIT_MONEY, COL_DEBIT_MONEY, _
                        COL_CREDIT_MONEY, COL_CREDIT_MONEY, COL_BALANCE_MONEY, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD2)
            Case "数量金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_AMOUNT, COL_DEBIT_MONEY, _
                        COL_CREDIT_AMOUNT, COL_CREDIT_MONEY, COL_BALANCE_AMOUNT, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "外币金额式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_FOREIGN, COL_DEBIT_MONEY, _
                        COL_CREDIT_FOREIGN, COL_CREDIT_MONEY, COL_BALANCE_FOREIGN, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
            Case "数量外币式"
                Call DoRedrawCellHead(m_iColWidth, COL_DEBIT_AMOUNT, COL_DEBIT_MONEY, _
                        COL_CREDIT_AMOUNT, COL_CREDIT_MONEY, COL_BALANCE_AMOUNT, COL_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
        End Select
    End If
End Sub

Private Sub cboSubject_Click()
    With cboSubject
        If Not m_bFormLoad And m_sPreSubject <> .text Then
            m_sCurSubjectCode = Mid(cboSubject.text, 1, InStr(1, cboSubject.text, "=") - 1)
            m_sCurSubjectName = Mid(cboSubject.text, InStr(1, cboSubject.text, "=") + 1)
            If m_bIncludeNotRecord Then
                 Me.ShowResultbak
            Else
                 Me.ShowResult
            End If
            cboSubject.SetFocus
        End If
        m_sPreSubject = .text
    End With
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_UNIT_PRICE Or col = COL_EXCHANGE_RATE Or _
                col = COL_DEBIT_AMOUNT Or col = COL_DEBIT_FOREIGN Or _
                col = COL_CREDIT_AMOUNT Or col = COL_CREDIT_FOREIGN Or _
                col = COL_BALANCE_AMOUNT Or col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "数量金额式"
            If col = COL_EXCHANGE_RATE Or col = COL_DEBIT_FOREIGN Or _
                col = COL_CREDIT_FOREIGN Or col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "外币金额式"
            If col = COL_UNIT_PRICE Or col = COL_DEBIT_AMOUNT Or _
                col = COL_CREDIT_AMOUNT Or col = COL_BALANCE_AMOUNT Then
                approve = False
            Else
                approve = True
            End If
        Case "数量外币式"
            approve = True
    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

'双击单元格
 '-----------------changjh edit-----------
Private Sub cllR_mousedclick(ByVal col As Long, ByVal row As Long)
    Dim frmV As frmVoucher
    Dim VoucherMuster As AccountExtend.clsVoucherCollentionCx
    Dim iGlo As GlobalInterface.clsGlobal, iGlosys As GlobalInterface.clsGlobalSys

    Dim sMonth As String
    Dim sDay As String
    Dim sPZZL As String
    Dim sPZBH As String

    sMonth = Cllr.GetCellString(2, row, Cllr.GetCurSheet)
    sDay = Cllr.GetCellString(3, row, Cllr.GetCurSheet)
    sPZZL = Cllr.GetCellString(4, row, Cllr.GetCurSheet)
    sPZBH = Cllr.GetCellString(5, row, Cllr.GetCurSheet)
    
If sMonth <> "" And sDay <> "" And sPZZL <> "" And sPZBH <> "" Then
        '当所在行在凭证记录上时, 调用凭证查询
        If IsNumeric(sMonth) And IsNumeric(sDay) Then
            If CInt(sMonth) >= 1 And CInt(sMonth) <= 12 _
                And CInt(sDay) >= 1 And CInt(sDay) <= 31 Then
                Set frmV = New frmVoucher
                Set VoucherMuster = New AccountExtend.clsVoucherCollentionCx
                Set iGlo = New GlobalInterface.clsGlobal
                Set iGlosys = New GlobalInterface.clsGlobalSys
                InitGloInface iGlo, iGlosys
                VoucherMuster.iGlo = iGlo
                VoucherMuster.iGlosys = iGlosys
                VoucherMuster.Add sPZBH, sPZZL, glo.sOperateYear & "-" & CStr(sMonth) & "-" & sDay
                VoucherMuster.Index = 1
                VoucherMuster.Voucher = VoucherMuster.Item(1)
                VoucherMuster.Voucher.Load
                
                frmV.LoadObject = "AccountExtend.clsVoucherCollentionCx"
                Load frmV
                frmV.IsModePrint = (glo.detailPrintMode = "套打")
                frmV.cBr.Bands(4).Visible = False
                
                frmV.Show
                
                frmV.LoadingObjects = VoucherMuster
                frmV.Reload VoucherMuster.Voucher
                           
            End If
        End If
    End If
End Sub
'---------------------edit end-------------

Private Sub cllR_MouseRClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
    If updn = False Then
        m_iCol = col
        m_iRow = row
        fMainForm.mnuBalanceResult.Visible = False
        fMainForm.mnuDetailResult.Visible = False
        fMainForm.mnuVoucherResult.Visible = True
        fMainForm.mnuDailyResult.Visible = False
        PopupMenu fMainForm.mnuQueryAccount
    End If
End Sub
Private Sub Form_Activate()
TbrControl False
End Sub

Private Sub Form_Deactivate()
TbrControl True
End Sub
Private Sub form_load()
    Dim i As Integer
    TbrControl False
    m_bFormLoad = True
        
   ' Me.Caption = "明细账查询 - “" & m_sCurSubjectCode & "=" & m_sCurSubjectName & "”"
    usAccountType = "明细账"
    usAccountFormat = "金额式"
    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
        
    For i = LBound(arySubDetail) + 1 To UBound(arySubDetail)
        If Trim$(arySubDetail(i).sSubjectCode) <> "" Then
            cboSubject.AddItem arySubDetail(i).sSubjectCode & "=" & arySubDetail(i).sSubjectName
        End If
    Next i
    If cboSubject.ListCount <> 0 Then
        If m_sSubjectCodeStart <> "" Then
            If SetCbo(m_sSubjectCodeStart, m_sSubjectNameStart) Then
            Else
                cboSubject.ListIndex = 0
            End If
        Else
            cboSubject.ListIndex = 0
        End If
    End If
    
    With Cllr
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        If .OpenFile(App.Path & "\CellFiles\Detail.cll", "") = -1 Then
            MsgBox "CELL文件不存在！", vbOKOnly
        End If
       .ResetContent
       .SetCols COL_END + 2, 0
       .SetRows ROW_GRID_START + ROWS_PAGE, 0
       .SetDefaultFont .FindFontIndex("宋体", 1), 10        '字体; 9号字, 0=粗体, 宋体
       .WorkbookReadonly = True   '表格只读
       .AllowSizeColInGrid = True
    End With
    m_bFormLoad = False