frmac_randommulticolresult.frm

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

    m_arrColInformation = NewValue
End Property
Public Sub uPreview()
    With Cllr
        .PrintPreview 1, .GetCurSheet
        .SaveFile App.Path & "\CellFiles\" & m_sAccountName & ".cll", 0
    End With
End Sub
Public Sub uPrint()
    Dim frmPage As frmPageSet
    Dim lTotalPages As Long, i As Long
    
    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 Sub

Private Sub cboAccountbook_Click()
'得到查询账本
Dim i As Integer
Dim rstTmp As ADODB.Recordset
Dim sSQL As String
Dim sTmp As String
If m_bFormLoad Then Exit Sub
Me.MousePointer = vbHourglass
If cboAccountbook.ListIndex < 0 Or cboAccountbook.ListCount = 0 Or Trim(cboAccountbook.text) = "" Then GoTo ExitSub
Set rstTmp = New ADODB.Recordset
rstTmp.CursorLocation = adUseClient
sSQL = "select * from TFZ_MULAccountBOOK where CID='" & GetLeftRight(cboAccountbook.text, "=", True) & "'"
With rstTmp
    .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    If .RecordCount <= 0 Then Exit Sub
        m_sMode = Trim("" & .Fields("CMode"))
'        m_sMonthFrom = Right(Trim("" & .Fields("CMonthFrom")), 2)
'        m_sMonthTo = Right(Trim("" & .Fields("CMonthTo")), 2)
'        m_bIncludeNotRecordVoucher = .Fields("bIncludeNotRecordVoucher")
'        m_bShowNotMoneyCol = .Fields("BShowNotMoneyCol")
        m_sSubjectCode = Trim("" & .Fields("CSubjectCode"))
'        m_sDeptCode = Trim("" & .Fields("CDeptCode"))
'        m_sItemCodeCollect = Trim("" & .Fields("CsItemCodeCollect"))
'        m_bAmount = .Fields("BAmount")
'        m_bForeign = .Fields("BForeign")
'        m_iLevel = .Fields("iLevel")
        Me.usAccountType = Trim("" & .Fields("CAccountType"))
    If .State = 1 Then .Close
    sSQL = "select CCOLCODE,CCOLNAME,ICOLLEVEL,CCOLDIRECT from TFZ_MULAccountBOOKCol where CID='" & GetLeftRight(cboAccountbook.text, "=", True) & "' order by CNUM"
    .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    If .RecordCount <= 0 Then Exit Sub
    ReDim Preserve m_arrColInformation(.RecordCount - 1)
    i = 0
    For i = 0 To .RecordCount - 1
        Set m_arrColInformation(i) = New clsSubSys
        m_arrColInformation(i).sColCode = .Fields("CCOLCODE")
        m_arrColInformation(i).sColName = .Fields("CCOLNAME")
        m_arrColInformation(i).iColLevel = .Fields("ICOLLEVEL")
        m_arrColInformation(i).sColDirect = .Fields("CCOLDIRECT")
        m_arrColInformation(i).iColNum = i
        If Trim(.Fields("CCOLCODE")) <> "借方合计" And Trim(.Fields("CCOLCODE")) <> "贷方合计" Then
            sTmp = sTmp & Trim(.Fields("CCOLCODE")) & ","
        End If
        .MoveNext
    Next
     sTmp = DelLastChar(sTmp, 1)
     If m_sAccountType = "科目" Then
         If m_sSubjectCode = "" Then
            m_sSubjectCode = sTmp
         End If
     ElseIf m_sAccountType = "部门" Then
         If m_sDeptCode = "" Then
            m_sDeptCode = sTmp
         End If
     Else
         If m_sItemCodeCollect = "" Then
            m_sItemCodeCollect = sTmp
         End If
    End If
End With
rstTmp.Close
Set rstTmp = Nothing
InitVariable
InitCell
ShowResult
ExitSub:
Me.MousePointer = vbDefault
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

    If col = iCol_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()
    m_bFormLoad = True
    Call InitCell
    Call InitVariable
    Call LoadAccountToCbo
    Me.Caption = m_sAccountName
    With Cllr
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
'        .SetCols iCol_End + 2, 0
'        .SetRows ROW_GRID_START + ROWS_PAGE, 0
    End With
    m_bFormLoad = False
End Sub
'=============================装载账本========================================
Private Sub LoadAccountToCbo()
Dim rstTmp As ADODB.Recordset
Dim sSQL As String
    Set rstTmp = New ADODB.Recordset
    rstTmp.CursorLocation = adUseClient
    sSQL = "select * from TFZ_MULACCOUNTBOOK where cname like '" & m_sAccountName & "%'  order by CID"
    rstTmp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With cboAccountbook
         .Clear
         While Not rstTmp.EOF
             .AddItem rstTmp.Fields("CID") & "=" & Right(rstTmp.Fields("CNAME"), Len(rstTmp.Fields("CNAME")) - Len(m_sAccountName))
             rstTmp.MoveNext
         Wend
         .Left = Picture1.Left + Picture1.Width
         .Top = 680
         .Width = 3000
    End With
    rstTmp.Close
    Set rstTmp = Nothing
End Sub
'初始化变量
Private Sub InitVariable()
Dim i As Integer
Dim sDirection As String

m_sDefaultColWidth = COLWIDTH_MONEY
'求出各列的宽度
m_iColWidth = GetColWidth(m_sAccountName, m_sMode, m_sDefaultColWidth)
m_iColWidthTemp = m_iColWidth

m_bDebitSum = False: m_bCreditSum = False: sDirection = "借方"
iCol_DebitEnd = 0
If GetLocate("借方合计") <> -1 Then m_bDebitSum = True
If GetLocate("贷方合计") <> -1 Then m_bCreditSum = True
For i = LBound(m_arrColInformation) To UBound(m_arrColInformation)
    If sDirection <> m_arrColInformation(i).sColDirect Then iCol_DebitEnd = COL_ACTION_BEGIN - 1 + (i) * 3: Exit Sub
    sDirection = m_arrColInformation(i).sColDirect
Next
If sDirection = "借方" Then
   iCol_DebitEnd = COL_ACTION_BEGIN - 1 + (i) * 3
Else
   iCol_DebitEnd = COL_ACTION_BEGIN - 1
End If
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(m_sAccountName & "格式已经改变，是否保存？", _
                    vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Call SaveColChange(m_iColWidth, m_sAccountName, m_sMode)
'        End If
    End If
    m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuAccountMultiCol", lMutexID
End Sub

Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long)
    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                    'Cell重第零页开始计数
    'set cllr
        .SetRows FactRows, PageNo - 1
        .SetCols iCol_End + 2, PageNo - 1
        .SetSelectMode PageNo - 1, 2                           '允许整行选择
        .SetFixedCol COL_START, COL_DAY             '设置不滚动列
        .SetFixedRow ROW_TITLE, ROW_GRIDHEAD3       '设置不滚动行
'        .ShowSideLabel 0, PageNo - 1                        '行标不可见
'        .ShowTopLabel 0, PageNo - 1                       '列标不可见
        .SetDefaultFont .FindFontIndex("宋体", 1), 9                  '字体; 8号字, 0=粗体, 宋体
        .WorkbookReadonly = True                                  '表格只读
        .AllowSizeColInGrid = True
        .SetDefaultRowHeight PageNo - 1, 1, 19