frmac_bookresult.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CELLCT~1.OCX"
Begin VB.Form frmAC_BookResult 
   Caption         =   "日记账"
   ClientHeight    =   6045
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8850
   HelpContextID   =   1053
   Icon            =   "frmAC_BookResult.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6045
   ScaleWidth      =   8850
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.ComboBox CboSubject 
      Height          =   300
      Left            =   1110
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   990
      Width           =   2715
   End
   Begin VB.ComboBox cboAccountFormat 
      Height          =   300
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   690
      Width           =   1605
   End
   Begin CELL50Lib.Cell Cllr 
      Height          =   5775
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   8535
      _Version        =   65536
      _ExtentX        =   15055
      _ExtentY        =   10186
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmAC_BookResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
'日记账
'1)当本日合计在页末时，无“过次页”
'2)当本日合计在倒数第二行（29行）时，“过次页”照抄
'3)当本日合计在29行,本月合计在30行时,无"过次页"
'4)当本期累计在29行,"过次页"只填余额


'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 = "40,30,30,50,50,50,220,0,0,0,0,120,0,0,120,25,0,0,120,6,60,50,30,30,30,50"

'数量金额式账页缺省列宽
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 brhjJ As Double, brhjD As Double
Dim brhjJSL As Double, brhjJWB As Double
Dim brhjDSL As Double, brhjDWB As Double

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

Dim sFX As String                       '方向

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

Dim dYE As Double, dYESL As Double, dYEWB As Double

Dim sbyFX As String                 '本月合计余额方向
Dim sbyYE As Double                 '本月合计余额
Dim CurRow As Long                       '存放当前行的行数(从表格开始行计数)
Dim lCount As Long                  '数据行的行数(从数据行开始计数)
Dim lPage As Long                   '当前所在页

Dim m_sYear As String               '查账年份
Dim m_sFromDate As String           '查询开始日期
Dim m_sToDate 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_bIncludeNotRecord  As Boolean '未记账标志

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    '当前账页的缺省列宽

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

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 m_iRjzIndex As Integer
Dim bFirstFlag As Boolean
Dim m_sPreSubject As String
Dim m_sDaySubjectName As String
Dim m_sPrintSubjectCode As String
Dim m_sPrintSubjectName As String
Dim m_iID As Integer

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 usSubjectName(ByVal sName As String)
    m_sSubjName = sName
End Property
Public Property Let usSubjectCode(ByVal sCode As String)
    m_sSubjCode = sCode
End Property

Public Property Let usFromDate(ByVal sFromDate As String)
    m_sFromDate = sFromDate
End Property

Public Property Let usToDate(ByVal sToDate As String)
    m_sToDate = sToDate
End Property

Public Property Let usSubjectIndex(ByVal iIndex As Integer)
    m_iRjzIndex = iIndex
End Property
Public Property Let usIncludeNotRecord(ByVal bInclude As Boolean)
    m_bIncludeNotRecord = bInclude
End Property

Public Sub uPreview()

    Cllr.PrintPreview 1, Cllr.GetCurSheet
    If Cllr.SaveFile(App.Path & "\CellFiles\book.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
    
    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

'联查总账
Public Sub uBalanceResult()
    Dim i As Integer
    Dim bFound As Boolean
    Dim frmR As frmAC_GeneralResult
    
    For i = 0 To Forms.Count - 1
        If Forms(i).Tag = m_sSubjCode 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_sSubjCode
        frmR.usSubjectNameStart = m_sSubjName
        frmR.usSubjectCodeEnd = ""
        frmR.usSubjectNameEnd = ""
        frmR.usSubjectJcFlag = True
        frmR.Tag = m_sSubjCode
        frmR.Kmmc_set
        If m_bIncludeNotRecord Then
          frmR.ShowResultIncludeNotRec
        Else
          frmR.ShowResult
        End If
    End If