frmyh_yetjb.frm

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

      AllowCustomize  =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   7
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "print"
            Object.ToolTipText     =   "打印"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "preview"
            Object.ToolTipText     =   "预览"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "明细"
            Key             =   "Detail"
            Object.ToolTipText     =   "显示未达账项明细表"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "help"
            Object.ToolTipText     =   "帮助"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "exit"
            Object.ToolTipText     =   "退出"
            ImageIndex      =   4
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
   Begin VB.Label lblJzrq 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "对账截止日期："
      Height          =   180
      Left            =   6960
      TabIndex        =   28
      Top             =   690
      Width           =   1260
   End
   Begin VB.Label lblKmmc 
      AutoSize        =   -1  'True
      Caption         =   "科目："
      Height          =   180
      Left            =   120
      TabIndex        =   27
      Top             =   690
      Width           =   540
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuPrint 
         Caption         =   "打印"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuPreview 
         Caption         =   "预览(&V)"
      End
      Begin VB.Menu mnuLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuDetail 
      Caption         =   "明细"
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
   End
End
Attribute VB_Name = "frmYH_Yetjb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'以下一段常量用于窗体frm_print的CELL打印
'-------------------------------------------------------------
'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;

Const ROWS_PAGE = 30                '每页行数

Const COL_START = 1                 '开始列
Const COL_ITEM_YH = 1               '银行方项目
Const COL_MONEY_YH = 2              '银行方的金额
Const COL_ITEM_DW = 3               '单位方项目
Const COL_MONEY_DW = 4              '单位方的金额
Const COL_END = 4

Const ROW_TITLE = 1                 '标题
Const ROW_BLANK = 2
Const ROW_SUBJNAME = 3              '页眉
Const ROW_HEAD1 = 4                 '页标头行
Const ROW_GRID_START = 5            '表格开始行

Const CRB_LINE = vbBlack            '表格线颜色

'缺省列宽
Const ColWidth = "180,150,180,150"

Dim sEnterName As String            '单位名称
Dim frmP As frmPrint                '通用打印窗体(CELL)
'-------------------------------------------------------------

Private Sub form_load()
    '得到当前账套的单位名称
    sEnterName = GetDWMC
    If sEnterName = "" Then
        MsgBox "缺少单位名称！", vbInformation
        Exit Sub
    End If
    Set frmP = New frmPrint
    With frmP.CllR
        .SetCols COL_END + 2, 0
        .SetRows ROW_GRID_START + ROWS_PAGE, 0
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload frmP
End Sub

Private Sub mnuDetail_Click()
    Call Operate("Detail")
End Sub

Private Sub mnuExit_Click()
    Call Operate("EXIT")
End Sub

Private Sub mnuHelp_Click()
    Call Operate("HELP")
End Sub

Private Sub mnuPreview_Click()
    Call Operate("PREVIEW")
End Sub

Private Sub mnuPrint_Click()
    Call Operate("PRINT")
End Sub

Private Sub tbrYetjbqc_ButtonClick(ByVal Button As MSComctlLib.Button)
    Call Operate(UCase(Button.Key))
End Sub

Private Sub Operate(strKey As String)
    Select Case strKey
        Case "PRINT"
            Call ShowPrintResult("PRINT")
        Case "PREVIEW"
            Call ShowPrintResult("PREVIEW")
        Case "DETAIL"
            Call ShowDeTail
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Me.Hide
    End Select
End Sub

'设置打印表格
Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long)
    Dim i As Long, j As Long
    Dim iColWidth() As Integer
    
    With frmP.CllR
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .PrintSetMargin 10, 10, 10, 10
        .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
        .SetDefaultFont .FindFontIndex("宋体", 1), 10

    'Title
        .SetCellAlign COL_START, ROW_TITLE, PageNo - 1, 36
        .SetCellFont COL_START, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START, ROW_TITLE, PageNo - 1, 10
        .MergeCells COL_START, ROW_TITLE, COL_END, ROW_TITLE
        .SetCellString COL_START, ROW_TITLE, PageNo - 1, "余额调节表"
        .SetRowHeight 1, 40, ROW_TITLE, PageNo - 1
    'Comment
        .MergeCells COL_START, ROW_SUBJNAME, COL_MONEY_YH, ROW_SUBJNAME
        .MergeCells COL_ITEM_DW, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        
        .SetCellFont COL_START, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_START, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellAlign COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 34
        .SetCellFont COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 0
        
        .SetCellString COL_START, ROW_SUBJNAME, PageNo - 1, lblKmmc.Caption
        .SetCellString COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, lblJzrq.Caption
    'Head
         For i = ROW_HEAD1 To ROW_HEAD1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
                .SetCellAlign j, i, PageNo - 1, 36
                .SetCellTextStyle j, i, PageNo - 1, 2
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
        Next i
        
        '设置列宽
        iColWidth = GetColWidth(ColWidth)
        For i = LBound(iColWidth) To UBound(iColWidth)
            .SetColWidth 1, iColWidth(i), i + 1, PageNo - 1
        Next i
        .SetColWidth 1, 1, COL_END + 1, PageNo - 1
        
        '合并单元格
        .MergeCells COL_ITEM_YH, ROW_HEAD1, COL_MONEY_YH, ROW_HEAD1
        .MergeCells COL_ITEM_DW, ROW_HEAD1, COL_MONEY_DW, ROW_HEAD1
        
        '设置内容
        .SetCellString COL_ITEM_YH, ROW_HEAD1, PageNo - 1, "银行对账单"
        .SetCellString COL_ITEM_DW, ROW_HEAD1, PageNo - 1, "单位日记账"
        
    'Text
        For i = ROW_GRID_START To .GetRows(.GetCurSheet) - 1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_ITEM_YH, i, PageNo - 1, 33
            .SetCellAlign COL_MONEY_YH, i, PageNo - 1, 34
            .SetCellAlign COL_ITEM_DW, i, PageNo - 1, 33
            .SetCellAlign COL_MONEY_DW, i, PageNo - 1, 34
        Next i
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
        
    'Draw Line
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_ITEM_YH, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_MONEY_YH, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)

    'Print Corp & Date & Time
        .SetRows .GetRows(PageNo - 1) + 1, PageNo - 1
        i = .GetRows(PageNo - 1) - 1
        .MergeCells COL_START, i, COL_MONEY_YH, i
        .MergeCells COL_ITEM_DW, i, COL_END, i
        .SetCellAlign COL_START, i, PageNo - 1, 33
        .SetCellAlign COL_ITEM_DW, i, PageNo - 1, 34

        .SetCellFont COL_START, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, i, PageNo - 1, 11
        .SetCellFontStyle COL_START, i, PageNo - 1, 0
        .SetCellFont COL_ITEM_DW, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_ITEM_DW, i, PageNo - 1, 11
        .SetCellFontStyle COL_ITEM_DW, i, PageNo - 1, 0
        .SetCellString COL_START, i, PageNo - 1, "核算单位：" & sEnterName
        .SetCellString COL_ITEM_DW, i, PageNo - 1, "打印日期：" & Format(Date, "yyyy-mm-dd")
        .ShowPageBreak False
    End With

End Sub

'显示打印结果
Private Sub ShowPrintResult(ByVal sPrtStr As String)
    Dim lPage As Long
    Dim lCount As Long
    

    lPage = 0
    lCount = 0
    
    lCount = lCount + 1
    
    Call AppendOneRow(ROW_GRID_START + lCount - 1, "调整前余额：", txtYhtzqye.text, _
                    "调整前余额：", txtDwtzqye)
    lCount = lCount + 1
    
    Call AppendOneRow(ROW_GRID_START + lCount - 1, "加：单位已收、银行未收", txtDwys.text, _
                    "加：银行已收、单位未收", txtYhys.text)
    lCount = lCount + 1
    
    Call AppendOneRow(ROW_GRID_START + lCount - 1, "减：单位已付、银行未付", txtDwyf.text, _
                    "减：银行已付、单位未付", txtYhyf.text)
    lCount = lCount + 1
    
    Call AppendOneRow(ROW_GRID_START + lCount - 1, "调整后余额：", txtYhtzhye.text, _
                    "调整后余额：", txtDwtzhye.text)
    
    Call SetGrid(lPage + 1, ROW_GRID_START + lCount)
    frmP.CllR.SetCurSheet 0
    
    Me.Hide
    
    If sPrtStr = "PRINT" Then
        frmP.uPrint
    Else
        frmP.uPreview
    End If
    Me.Show 1
End Sub


'向表格中追加一行
Private Sub AppendOneRow(ByVal i As Long, ByVal sItem_yh As String, _
        ByVal sMoney_yh As String, ByVal sItem_dw As String, ByVal sMoney_dw As String)
        
    With frmP.CllR
        .SetCellString COL_ITEM_YH, i, .GetCurSheet, sItem_yh
        .SetCellString COL_MONEY_YH, i, .GetCurSheet, sMoney_yh
        .SetCellString COL_ITEM_DW, i, .GetCurSheet, sItem_dw
        .SetCellString COL_MONEY_DW, i, .GetCurSheet, sMoney_dw
    End With
    
End Sub

'得到每列宽度
Private Function GetColWidth(ByVal sColWidth As String) As Integer()
    Dim i As Integer
    Dim j As Integer
    Dim iColWidth() As Integer

    i = 0
    ReDim iColWidth(0 To i)
    For j = 1 To Len(sColWidth)
        If j = 1 Then
            iColWidth(i) = Mid(sColWidth, j, 1)
        ElseIf Mid(sColWidth, j, 1) <> "," Then
            iColWidth(i) = iColWidth(i) & Mid(sColWidth, j, 1)
        Else
            i = i + 1
            ReDim Preserve iColWidth(0 To i)
        End If
    Next j
    GetColWidth = iColWidth
End Function

'20020712 填加未达账项
Public Sub ShowDeTail()
'    Dim frmD As frmYH_YhwdzMx
'    Dim sTemp As String
'    Set frmD = New frmYH_YhwdzMx
'    sTemp = Mid(lblKmmc.Caption, InStr(lblKmmc.Caption, "：") + 1)
'    frmD.usSubjectName = Mid(sTemp, 1, InStr(sTemp, "(") - 1)
'    sTemp = Mid(sTemp, InStr(sTemp, "(") + 1)
'    frmD.usSubjectCode = Left(sTemp, Len(sTemp) - 1)
'    frmD.usDzdJzrq = Mid(lblJzrq.Caption, InStr(lblJzrq.Caption, "：") + 1)
'    frmD.Show 1
    Dim sTemp As String
    sTemp = Mid(lblKmmc.Caption, InStr(lblKmmc.Caption, "：") + 1)
    sTemp = Mid(sTemp, InStr(sTemp, "(") + 1)
    sTemp = Left(sTemp, Len(sTemp) - 1)
    Dim i As Integer
    For i = 0 To frmYH_Yhkmxz.cboKmmc.ListCount - 1
        If InStr(1, frmYH_Yhkmxz.cboKmmc.List(i), sTemp) > 0 Then
            frmYH_Yhkmxz.cboKmmc.ListIndex = i
            frmYH_Yhkmxz.kmdm = sTemp
            Exit For
        End If
    Next
    frmYH_Yhkmxz.Ok = True
    Dim frmD As New frmYH_Yhdzcx
    frmD.Show 1, Me
End Sub