frmac_detailmodeprint.frm

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

            Cllr.SetCurSheet i
            If m_iPrintedPages + 1 >= txtPrintStart And m_iPrintedPages + 1 <= MaxEnablePrintPageNo Then
                 Cllr.PrintSheet 0, i
            End If
            m_iPrintedPages = m_iPrintedPages + 1
        Next i
    Else
        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
                    Cllr.SetCurSheet i - 1
                    Cllr.PrintSheet 0, i - 1
                Next i
            End If
        End With
        Unload frmPage
    End If
End Sub

'账页格式被改变时触发
Private Sub cboAccountFormat_Click()
    Dim sOldAccountFormat As String     '账页原先格式
    Dim i As Integer
    Dim j As Integer
    If Not m_bFormLoad Then
        If ubVisible = True 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
             i = 1
            ReDim m_iColWidth(1 To i)
            For j = 1 To Len(m_sDefaultColWidth)
                If j = 1 Then
                    m_iColWidth(i) = Mid(m_sDefaultColWidth, j, 1)
                ElseIf Mid(m_sDefaultColWidth, j, 1) <> "," Then
                    m_iColWidth(i) = m_iColWidth(i) & Mid(m_sDefaultColWidth, j, 1)
                Else
                    i = i + 1
                    ReDim Preserve m_iColWidth(1 To i)
                End If
            Next j
            m_iColWidthTemp = m_iColWidth
        End If
        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)
            Me.Cllr.ResetContent
            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)
approve = False
End Sub
'''    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

Private Sub form_load()
    Dim i As Integer
    Dim j As Integer
    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
    '求出各列的宽度(设置套打的列宽，xiao）

     i = 1
    ReDim m_iColWidth(1 To i)
    For j = 1 To Len(m_sDefaultColWidth)
        If j = 1 Then
            m_iColWidth(i) = Mid(m_sDefaultColWidth, j, 1)
        ElseIf Mid(m_sDefaultColWidth, j, 1) <> "," Then
            m_iColWidth(i) = m_iColWidth(i) & Mid(m_sDefaultColWidth, j, 1)
        Else
            i = i + 1
            ReDim Preserve m_iColWidth(1 To i)
        End If
    Next j
     
    m_iColWidthTemp = m_iColWidth
        
    For i = LBound(arySubDetail) + 1 To UBound(arySubDetail)
        cboSubject.AddItem arySubDetail(i).sSubjectCode & "=" & arySubDetail(i).sSubjectName
    Next i
    If cboSubject.ListCount <> 0 Then
       cboSubject.ListIndex = 0
    End If
    
    With Cllr
'将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        Cllr.SetCols 1, 0
        Cllr.SetRows 1, 0
        .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
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Cllr.Width = Me.ScaleWidth - 100
    Cllr.Height = Me.ScaleHeight - 200
End Sub

'窗体卸载前, 检查账页的列宽是否被调整
Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    If IsColChange(Me.Cllr, m_iColWidth) = True Then
'        If MsgBox(usAccountFormat & "账簿格式已经改变，是否保存？", _
'                    vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Call SaveColChange(m_iColWidth, usAccountType, usAccountFormat)
'        End If
    End If
    If Cllr.GetTotalSheets > 1 Then
        Cllr.DeleteSheet 1, Cllr.GetTotalSheets - 1
    End If
    Cllr.closefile
End Sub

Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long, Optional ByVal iPageStart As Integer = 0)
    Dim i As Long, j As Long
    Dim iAmountLen As Integer       '数量单位字符串的长度
    Dim iForeignlen As Integer      '外币单位字符串的长度
    Dim iPageNoLen As Integer       '页号字符串的长度
    Dim maxLen As Integer           '最大字符串的长度

    With Cllr
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .SetSelectMode PageNo - 1, 2
        .SetFixedCol COL_START, COL_BILL
        .SetFixedRow ROW_TITLE, ROW_HEAD2
'        .PrintSetMargin 10, 25, 23, 23
        .PrintSetPaper 39
        .PrintSetOrient 0
        .ShowSideLabel 0, PageNo - 1                         '行标不可见
        .ShowTopLabel 0, PageNo - 1                          '列标不可见
        .SetDefaultRowHeight PageNo - 1, 1, 25.5
        If g_CH = -1 Then
            .SetDefaultRowHeight PageNo - 1, 1, 25.5
        End If
'
      'Title
        .SetCellAlign COL_START, ROW_TITLE, PageNo - 1, 36
        .SetCellFont COL_START, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START, ROW_TITLE, PageNo - 1, 9
        .MergeCells COL_START, ROW_TITLE, COL_END, ROW_TITLE
        .SetCellString COL_START, ROW_TITLE, PageNo - 1, m_sGeneralSubjectName & "明细账"
        .SetRowHeight 1, 26, ROW_TITLE, PageNo - 1

    'Comment
        .SetRowHeight 1, 23, ROW_SUBJCODE, PageNo - 1
        .SetRowHeight 1, 23, ROW_SUBJNAME, PageNo - 1
        .MergeCells COL_START, ROW_SUBJNAME, COL_BALANCE_FOREIGN, ROW_SUBJNAME
        .MergeCells COL_BALANCE_MONEY, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        '如果是数量账或者外币账, 则设置数量单位和外币单位格
        If m_bAmount Or m_bForeign Then
            If m_bAmount And m_bForeign Then
                .MergeCells COL_START, ROW_ACCOUNTFORMAT, COL_BALANCE_FOREIGN, ROW_ACCOUNTFORMAT
                .MergeCells COL_BALANCE_MONEY, ROW_ACCOUNTFORMAT, COL_END, ROW_ACCOUNTFORMAT
                .SetCellFont COL_BALANCE_MONEY, ROW_ACCOUNTFORMAT, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize COL_BALANCE_MONEY, ROW_ACCOUNTFORMAT, PageNo - 1, 11
                .SetCellFontStyle COL_BALANCE_MONEY, ROW_ACCOUNTFORMAT, PageNo - 1, 0
                .SetCellAlign COL_BALANCE_MONEY, ROW_ACCOUNTFORMAT, PageNo - 1, 34
            Else
                .MergeCells COL_START, ROW_ACCOUNTFORMAT, COL_END, ROW_ACCOUNTFORMAT
            End If
            .MergeCells COL_START, ROW_SUBJCODE, COL_BALANCE_FOREIGN, ROW_SUBJCODE