frmac_dailyresult.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form frmAC_DailyResult 
   Caption         =   "日报表"
   ClientHeight    =   5145
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8880
   HelpContextID   =   1054
   Icon            =   "frmAC_DailyResult.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   5145
   ScaleWidth      =   8880
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
   Begin CELL50Lib.Cell Cllr 
      Height          =   4935
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   8295
      _Version        =   65536
      _ExtentX        =   14631
      _ExtentY        =   8705
      _StockProps     =   0
   End
   Begin VB.ComboBox cboAccountFormat 
      Height          =   300
      Left            =   90
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   780
      Width           =   1995
   End
End
Attribute VB_Name = "frmAC_DailyResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Option Base 1
'日报表
'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;

Const ROWS_PAGE = 30                        '每页行数
Const COL_START = 1                         '开始列数
Const COL_SUBJECTCODE = 1                   '科目代码
Const COL_SUBJECTNAME = 2                   '科目名称

Const COL_BEGIN_DIRECTION = 3               '期初余额方向

Const COL_BEGIN_BALANCE_AMOUNT = 4          '期初数量余额
Const COL_BEGIN_BALANCE_FOREIGN = 5         '期初外币余额
Const COL_BEGIN_BALANCE_MONEY = 6           '期初金额余额

Const COL_HAPPEN_DEBIT_AMOUNT = 7           '本期发生数量借方
Const COL_HAPPEN_DEBIT_FOREIGN = 8          '本期发生外币借方
Const COL_HAPPEN_DEBIT_MONEY = 9            '本期发生金额借方

Const COL_HAPPEN_CREDIT_AMOUNT = 10         '本期发生数量贷方
Const COL_HAPPEN_CREDIT_FOREIGN = 11        '本期发生外币贷方
Const COL_HAPPEN_CREDIT_MONEY = 12          '本期发生金额贷方

Const COL_END_DIRECTION = 13                '期末余额方向
Const COL_END_BALANCE_AMOUNT = 14           '期末数量余额
Const COL_END_BALANCE_FOREIGN = 15          '期末外币余额
Const COL_END_BALANCE_MONEY = 16            '期末金额余额

Const COL_END = 16                          '结束列
Const ROW_TITLE = 1                         '标题
Const ROW_ACCOUNTFORMAT = 2                 '账页格式行
Const ROW_PERIOD = 3                        '页眉
Const ROW_HEAD1 = 4                         '页标头行1
Const ROW_HEAD2 = 5                         '页标头行2
Const ROW_GRID_START = 6                    '表格开始行

Const ROW_DATE = 2
Const ROW_PAGENO = 3

'标题
Const DefaultTitleFontName = "黑体"
Const DefaultTitleFontSize = 20
Const DefaultTitleRowHigh = 10.25
'表头
Const DefaultHeadFontName = "仿宋_GB2312"
Const DefaultHeadFontSize = 10
Const DefaultHeadRowHigh = 4
'数据
Const DefaultDataFontName = "宋体"
Const DefaultDataFontSize = 9
Const DefaultDataRowHigh = 4

'打印使用标题
Const PrintTitleFontName = "黑体"
Const PrintTitleFontSize = 20
Const PrintTitleRowHigh = 10.25
'打印表头
Const PrintHeadFontName = "仿宋_GB2312"
Const PrintHeadFontSize = 12
Const PrintHeadRowHigh = 6
'打印数据
Const PrintDataFontName = "宋体"
Const PrintDataFontSize = 11
Const PrintDataRowHigh = 6

'金额式账页缺省列宽
Const COLWIDTH_MONEY = "100,200,30,0,0,120,0,0,120,0,0,120,30,0,0,120"

'数量金额式账页缺省列宽
Const COLWIDTH_AMOUNT = "100,200,30,120,0,120,120,0,120,120,0,120,30,120,0,120"

'外币金额式账页缺省列宽
Const COLWIDTH_FOREIGN = "100,200,30,0,120,120,0,120,120,0,120,120,30,0,120,120"

'数量外币式账页缺省列宽
Const COLWIDTH_AMOUNT_FOREIGN = "100,200,30,120,120,120,120,120,120,120,120,120,30,120,120,120"

Dim m_sDate As String                  '日报表的日期
Dim m_sMonth As Integer
Dim m_sSubjCodeStart As String, m_sSubjNameStart As String    '起始科目
Dim m_sSubjCodeEnd As String, m_sSubjNameEnd As String        '终止科目
Dim m_sPrintSubjectName As String      '设置打印一级科目
Dim m_bUnCheck As Boolean              '包含未记账
Dim m_bIncludeBlankKm As Boolean       '包含空白科目
Dim m_sKmCode() As String              '存放科目的代码
Dim m_iColWidth() As Integer        '存放表格各列的宽度
Dim usAccountFormat As String
Dim usAccountType As String
Dim m_iCol As Integer               '鼠标右击单元格所在行
Dim m_iRow As Integer               '鼠标右击单元格所在列

Dim m_iColWidthTemp() As Integer    '存放表格列宽被修改后的宽度
Dim m_sDefaultColWidth As String    '当前账页的缺省列宽
Dim m_iID As Integer

Private mPrintTitle As New clsRowType          '打印时标题类型
Private mPrintData As New clsRowType           '打印时数据类型
Private mPrintHead As New clsRowType           '打印时表头类型

Private mIsPrint As Boolean                    '是否在打印
Dim m_bFormLoad As Boolean

Public Property Let usDate(ByVal sdate As String)
    m_sDate = sdate
End Property

Public Property Let usMonth(ByVal sMonth As Integer)
    m_sMonth = sMonth
End Property

Public Property Let usSubjectCodeStart(ByVal sCode As String)
    m_sSubjCodeStart = sCode
End Property

Public Property Let usSubjectNameStart(ByVal sName As String)
    m_sSubjNameStart = sName
End Property

Public Property Let usSubjectCodeEnd(ByVal sCode As String)
    m_sSubjCodeEnd = sCode
End Property

Public Property Let usSubjectNameEnd(ByVal sName As String)
    m_sSubjNameEnd = sName
End Property

Public Property Let ubUnCheck(ByVal bUnCheck As Boolean)
    m_bUnCheck = bUnCheck
End Property

Public Property Let ubIncludeBlankKm(ByVal bUnCheck As Boolean)
    m_bIncludeBlankKm = bUnCheck
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\Daily.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_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_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_END_BALANCE_AMOUNT, COL_END_BALANCE_MONEY, _
                        ROW_HEAD1, ROW_HEAD1)
        End Select
    End If
End Sub

'双击单元格
Private Sub cllR_mousedclick(ByVal col As Long, ByVal row As Long)
    Dim frmR As frmAC_DetailResult
    Dim frmP As frmAC_BookResult
    Dim sMonth As Variant
    Dim sSubjCode As String
    Dim sSubjName As String
    Dim i As Integer
    Dim sSQL As String
    Dim bRjz As Boolean
    Dim rstRec As New Recordset
    
    sMonth = Month(m_sDate)
    sSubjCode = Cllr.GetCellString(1, row, Cllr.GetCurSheet)
    sSubjName = Cllr.GetCellString(2, row, Cllr.GetCurSheet)
    If sSubjCode = "" Or sSubjCode = "合 计：" Then
       Exit Sub
    End If
    '当所在行在本月合计和本年累计时, 调用明细账查询
    If IsNumeric(sMonth) Then
        If CInt(sMonth) >= 1 And CInt(sMonth) <= 12 Then
            sSQL = "select isRjz from tzw_km" & glo.sOperateYear & " where kmdm='" & sSubjCode & "'"
            With rstRec
               .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly