frmac_generalresult.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form frmAC_GeneralResult 
   Caption         =   "总账"
   ClientHeight    =   6105
   ClientLeft      =   1425
   ClientTop       =   1395
   ClientWidth     =   8880
   HelpContextID   =   1051
   Icon            =   "frmAC_GeneralResult.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6105
   ScaleWidth      =   8880
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.ComboBox cboSubject 
      Height          =   300
      Left            =   1140
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   930
      Width           =   2895
   End
   Begin VB.ComboBox cboAccountFormat 
      Height          =   300
      Left            =   60
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   630
      Width           =   1605
   End
   Begin CELL50Lib.Cell Cllr 
      Height          =   5535
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   8415
      _Version        =   65536
      _ExtentX        =   14843
      _ExtentY        =   9763
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmAC_GeneralResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

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

Const COL_START = 1                 '开始列
Const COL_MONTH = 1                 '月列
Const COL_DAY = 2                   '日列
Const COL_SUMMARY = 3               '摘要列
Const COL_DEBIT_AMOUNT = 4          '借方数量列
Const COL_DEBIT_FOREIGN = 5         '借方外币列
Const COL_DEBIT_MONEY = 6           '借方金额列
Const COL_CREDIT_AMOUNT = 7         '贷方数量列
Const COL_CREDIT_FOREIGN = 8        '贷方外币列
Const COL_CREDIT_MONEY = 9          '贷方金额列

Const COL_DIRECTION = 10             '方向列
Const COL_BALANCE_AMOUNT = 11       '数量余额列
Const COL_BALANCE_FOREIGN = 12      '外币余额列
Const COL_BALANCE_MONEY = 13        '金额余额列
Const COL_END = 13                  '结束列

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_TITLE = &H8080FF          '标题颜色
Const CRB_LINE = vbBlack            '表格线的颜色

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

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

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

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

Dim m_iYear As Integer              '查询年份
Dim m_iFromMonth As Integer         '查询开始月份
Dim m_iToMonth As Integer           '查询截止月份
Dim ijzMaxMonth As Integer          '记账的最大月分

Private Type NotRecordUDT
    sKjqj As String
    sKmdm As String
    sFx As String
    dSumAmount As Double
    dSumForeign As Double
    dSumMoney As Double
End Type
Private NotRecordData() As NotRecordUDT '存放未记账凭证的科目代码、方向、数量和、外币和、金额和

Private Type NotRecordBalanceUDR
   sKjqj As String
   dNBalance_Amount As Double
   dNBalance_Foreign As Double
   dNBalance_Money As Double
End Type
Private NotRecordBalance() As NotRecordBalanceUDR    '存放未记账凭证的的月份与余额及方向
 
Private Type MonthLjUDR
   sKjqj As String
   dDebit_Amount As Double
   dDebit_Foreign As Double
   dDebit_Money As Double
   dCredit_Amount As Double
   dCredit_Foreign As Double
   dCredit_Money As Double
End Type

Private tMonthLj(0 To 12) As MonthLjUDR       '存放1 到12 月的累计数
'---------------------------------------------------
'设置传递变量
Dim m_sSubjectCodeStart As String
Dim m_sSubjectNameStart As String
Dim m_sSubjectCodeEnd As String
Dim m_sSubjectNameEnd As String
Dim m_iSubjectJcStart As Integer
Dim m_iSubjectJcEnd As Integer
Dim m_bSubjectJcFlag As Integer
Dim m_bIncludeNotRecord As Boolean     '未记账凭证标记

Private Type udtKm
    sSubjectCode As String
    sSubjectName As String
End Type

Dim sFirstLevel() As udtKm           '存放一级科目代码范围
Dim arySubject() As udtKm            '存放明细科目名称范围
Dim arySubDetail() As udtKm
Dim bDetailFlag As Boolean           '科目是否有子科目
Private m_sPreSubject As String      '存放原先选择的科目
Dim m_sPrintSubjectName As String
Dim m_sPrintSubjectCode As String
Dim m_sGenSubjectName As String
Dim m_sGenSubjectCode 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_iID As Integer

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    '账页格式

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 usSubjectJcStart(ByVal sjcStart As Integer)
    m_iSubjectJcStart = sjcStart
End Property
Public Property Let usSubjectJcEnd(ByVal sjcEnd As Integer)
    m_iSubjectJcEnd = sjcEnd
End Property

Public Property Let usSubjectJcFlag(ByVal sJcFlag As Boolean)
    m_bSubjectJcFlag = sJcFlag
End Property

Public Property Let usIncludeNotRecordFlag(ByVal bNRFlag As Boolean)
    m_bIncludeNotRecord = bNRFlag
End Property

Public Function uiColWidth() As Integer()
    uiColWidth = m_iColWidth()
End Function

Public Sub uPreview()
    Cllr.PrintPreview 1, Cllr.GetCurSheet
    If Cllr.SaveFile(App.Path & "\CellFiles\General.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 uDetailResult()
    Call cllR_mousedclick(m_iCol, m_iRow)
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 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_sSubjCode = Mid(cboSubject.text, 1, InStr(1, cboSubject.text, "=") - 1)