frmac_detailmodeprint.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form frmAC_DetailModePrint 
   Caption         =   "明细账"
   ClientHeight    =   3195
   ClientLeft      =   5115
   ClientTop       =   4710
   ClientWidth     =   4680
   Icon            =   "frmAC_DetailModePrint.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   Begin VB.ComboBox cboAccountFormat 
      Height          =   300
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   690
      Width           =   1605
   End
   Begin VB.ComboBox cboSubject 
      Height          =   300
      Left            =   1170
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   1080
      Width           =   3405
   End
   Begin CELL50Lib.Cell Cllr 
      Height          =   3015
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   4575
      _Version        =   65536
      _ExtentX        =   8070
      _ExtentY        =   5318
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmAC_DetailModePrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'2001.01.23肖兆芹修改
'本模块只针对金额式账页进行套打，其他暂没考虑。2002.03.27
Option Explicit
'明细账
'与日记账相比，少一个本日合计

'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;

Const ROWS_PAGE = 30                '每页行数


Const COL_START = 1                 '开始列数
Const COL_SERIAL = 1                '序号
Const COL_MONTH = 2                 '月
Const COL_DAY = 3                   '日
Const COL_TYPE = 4                  '凭证种类
Const COL_NUMBER = 5                '凭证号码
Const COL_BILL = 6                  '单据号
Const COL_SUMMARY = 7               '摘要
Const COL_UNIT_PRICE = 8            '单价
Const COL_EXCHANGE_RATE = 9         '汇率
Const COL_DEBIT_AMOUNT = 10          '借方数量
Const COL_DEBIT_FOREIGN = 11         '借方外币
Const COL_DEBIT_MONEY = 12           '借方金额
Const COL_CREDIT_AMOUNT = 13        '贷方数量
Const COL_CREDIT_FOREIGN = 14       '贷方外币
Const COL_CREDIT_MONEY = 15         '贷方金额
Const COL_DIRECTION = 16            '方向
Const COL_BALANCE_AMOUNT = 17       '数量余额
Const COL_BALANCE_FOREIGN = 18      '外币余额
Const COL_BALANCE_MONEY = 19        '金额余额
Const COL_SEPARATE = 20             '分隔线
Const COL_MAN = 21                  '会计事项原处理人
Const COL_LOGOUT_YEAR = 22          '注销年
Const COL_LOGOUT_MONTH = 23         '注销月
Const COL_LOGOUT_DAY = 24           '注销日
Const COL_LOGOUT_TYPE = 25          '注销字
Const COL_LOGOUT_NUMBER = 26        '注销号
Const COL_END = 26                  '结束列

Const ROW_TITLE = 1                 '标题
Const ROW_ACCOUNTFORMAT = 2         '账页格式行
Const ROW_SUBJCODE = 3              '页眉科目代码
Const ROW_SUBJNAME = 4              '页眉科目名称
Const ROW_HEAD1 = 5                 '页标头行1
Const ROW_HEAD2 = 6                 '页标头行2
Const ROW_GRID_START = 7            '表格开始行

Const CRB_LINE = vbBlack            '表格线颜色

'金额式账页缺省列宽
Const COLWIDTH_MONEY = "45,33,34,46,50,108,296,0,0,0,0,170,0,0,140,37,0,0,134,24,76,57,30,30,30,0"

'数量金额式账页缺省列宽
Const COLWIDTH_AMOUNT = "40,30,30,50,50,50,220,100,0,120,0,120,120,0,120,25,120,0,120,6,60,50,30,30,30,50"

'外币金额式账页缺省列宽
Const COLWIDTH_FOREIGN = "40,30,30,50,50,50,220,0,100,0,120,120,0,120,120,25,0,120,120,6,60,50,30,30,30,50"

'数量外币式账页缺省列宽
Const COLWIDTH_AMOUNT_FOREIGN = "40,30,30,50,50,50,220,100,100,120,120,120,120,120,120,25,120,120,120,6,60,50,30,30,30,50"

Dim dUnit_Price As Double           '单价
Dim dExchange_Rate As Double        '汇率

Dim gcJ As Double, gcD As Double                        '过次页
Dim gcJSL As Double, gcDSL As Double
Dim gcJWB As Double, gcDWB As Double

Dim byhjJ As Double, byhjD As Double                    '本月合计
Dim byhjJSL As Double, byhjJWB As Double
Dim byhjDSL As Double, byhjDWB As Double

Dim bnljJ As Double, bnljD As Double                    '本年累计
Dim bnljJSL As Double, bnljJWB As Double
Dim bnljDSL As Double, bnljDWB As Double

Dim sbyFX As String                                     '本月合计余额方向
Dim dbyYESL As Double                                   '本月合计数量余额
Dim dbyYEWB As Double                                   '本月合计外币余额
Dim dbyYE As Double                                     '本月合计余额

Dim sFX As String                                       '本年累计余额方向

Dim dbnYESL As Double                                   '本年累计数量余额
Dim dbnYEWB As Double                                   '本年累计外币余额
Dim dbnYE As Double                                     '本年累计金额余额

Dim dYBJJe As Double                    '存放年初数
Dim dYBJSL As Double
Dim dYBJWB As Double
Dim dYBDJE As Double
Dim dYBDSL As Double
Dim dYBDWB As Double


Dim CurRow As Long                  '存放当前行的行数(从表格开始行计数)
Dim lCount As Long                  '数据行的行数(从数据行开始计数)
Dim lPage As Long                   '当前所在页

Dim m_sYear As String               '查账年份
Dim m_sFromMonth As String          '查账起始月
Dim m_sToMonth As String            '查账截止月
Dim m_sSubjCode As String           '科目代码
Dim m_sSubjName As String           '科目名称
Dim m_sEnterName As String          '单位名称
Dim m_sSldw As String               '数量单位
Dim m_sWbdw As String               '外币单位

Dim m_bAmount As Boolean            '是否数量账
Dim m_bForeign As Boolean           '是否外币账
Dim m_bFormLoad As Boolean          '是否在窗体引导状态

Dim m_iCol As Integer               '鼠标右击单元格所在行
Dim m_iRow As Integer               '鼠标右击单元格所在列
Dim m_iColWidth() As Integer        '存放表格初始化时各列的宽度
Dim m_iColWidthTemp() As Integer    '存放表格列宽被修改后的宽度
Dim m_sDefaultColWidth As String    '当前账页的缺省列宽

'---------------------------------------------------
'设置传递变量
Dim m_sSubjectCodeStart As String
Dim m_sSubjectNameStart As String
Dim m_sSubjectCodeEnd As String
Dim m_sSubjectNameEnd As String

Private Type udtKm
    sSubjectCode As String
    sSubjectName As String
End Type
Dim sFirstLevel() As udtKm           '存放一级科目代码范围
Dim arySubDetail() As udtKm
Dim bDetailFlag As Boolean           '科目是否有子科目
Private arySubject() As udtKm          '存放所选择科目的所有最明细子目
Private m_sCurSubjectCode As String      '当前要显示的最明细科目代码
Private m_sCurSubjectName As String      '当前要显示的最明细科目名称
Private m_sPreSubject As String          '存放原先选择的科目
Private m_bMjFlag As Boolean             '末级标志
Private m_bIncludeNotRecord As Boolean             '未记账凭证标志


Private m_sPrintSubjectCode As String    '打印时的科目代码
Private m_sPrintSubjectName As String    '打印时的科目名称

Private m_sGeneralSubjectName As String  '当前选择的科目的总账科目名称
Private m_iPrintedPages As Long          '已近打印的页数
Private txtPrintStart As Long            '打印起始页
Private txtPrintEnd As Long              '打印结束页
Private m_aryVar() As Double

Public usAccountType As String      '账页类型
Public usAccountFormat As String    '账页格式

Public ubVisible As Boolean     '是否Show
Public ubPrintDetail As Boolean         '非末级科目打印明细
Public ubQcBalance As Boolean
Public ubHappen As Boolean
'期初无余额,无发生
Public ubNoHaveQc As Boolean
'期初有余额，无发生
Public ubHaveQc As Boolean

'末级标志
Public Property Let usJcFlag(ByVal NewValue As Boolean)
    m_bMjFlag = NewValue
End Property
'未记账凭证标志
Public Property Let usNRFlag(ByVal bNRFlag As Boolean)
    m_bIncludeNotRecord = bNRFlag
End Property

Public Property Let usYear(ByVal sYear As String)
    m_sYear = sYear
End Property

Public Property Let usFromMonth(ByVal sFromMonth As String)
    m_sFromMonth = sFromMonth
End Property

Public Property Let usToMonth(ByVal sToMonth As String)
    m_sToMonth = sToMonth
End Property

Public Property Let usSubjectCodeStart(ByVal sCodeStart As String)
    m_sSubjectCodeStart = sCodeStart
End Property
Public Property Let usSubjectNameStart(ByVal sNameStart As String)
    m_sSubjectNameStart = sNameStart
End Property

Public Property Let usSubjectCodeEnd(ByVal sCodeEnd As String)
    m_sSubjectCodeEnd = sCodeEnd
End Property
Public Property Let usSubjectNameEnd(ByVal sNameEnd As String)
    m_sSubjectNameEnd = sNameEnd
End Property

Public Property Let usSubjectCurCode(ByVal sCurCode As String)
'从总账来的科目代码
    m_sCurSubjectCode = sCurCode
End Property
Public Property Let usSubjectCurName(ByVal sCurName As String)
'从总账来的科目名称
    m_sCurSubjectName = sCurName
End Property

'根据查询科目求出该科目的所有最明细子科目
Public Sub uGetEndKm()
    Dim adoRstTemp As ADODB.Recordset
    Dim i As Integer
    
    Set adoRstTemp = New ADODB.Recordset
    With adoRstTemp
        .CursorLocation = adUseClient
        .Open "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                " WHERE kmdm LIKE '" & m_sSubjCode & "%'" & _
                " AND IsEndKm = -1", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        ReDim arySubject(1 To .RecordCount)
        i = 0
        Do Until .EOF
            i = i + 1
            arySubject(i).sSubjectCode = Trim$(.Fields("kmdm").value)
            arySubject(i).sSubjectName = Trim$(.Fields("kmmc").value)
            .MoveNext
        Loop
        .Close
    End With
    Set adoRstTemp = Nothing
    
    m_sCurSubjectCode = arySubject(1).sSubjectCode
    m_sCurSubjectName = arySubject(1).sSubjectName
    
End Sub

Public Sub uPreview()
    Cllr.PrintPreview 1, Cllr.GetCurSheet
    If Cllr.GetTotalSheets > 1 Then
        Cllr.DeleteSheet 1, Cllr.GetTotalSheets - 1
    End If
    Cllr.SaveFile App.Path & "\CellFiles\DetailModePrint.cll", 1
    Cllr.closefile
End Sub

Private Function MaxEnablePrintPageNo() As Long
If IsNumeric(txtPrintEnd) Then
    If txtPrintEnd > 0 Then
        MaxEnablePrintPageNo = txtPrintEnd
    Else
        MaxEnablePrintPageNo = m_iPrintedPages + 1
    End If
Else
    MaxEnablePrintPageNo = m_iPrintedPages + 1
End If
End Function

Public Sub uPrint()
    Dim frmPage As frmPageSet
    Dim lTotalPages As Long, i As Long
    If ubVisible = False Then
        For i = 0 To Cllr.GetTotalSheets - 1