frmyh_yetjbcx.frm

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

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    Unload frmP
    Unload frmYH_Yetjb
End Sub

'双击余额调节表查询表格的单元格, 显示该科目的余额调节表
Private Sub mfgYetjbcx_DblClick()
    Dim CurNum As Integer
    If InStr(1, mfgYetjbcx.TextMatrix(mfgYetjbcx.Row, 0), "合   计") > 0 Then
       Exit Sub
    End If
    If m_bArr Then
        For i = LBound(ArrYetjb) To UBound(ArrYetjb)
            If ArrYetjb(i).Kmmc = mfgYetjbcx.TextMatrix(mfgYetjbcx.Row, 0) Then
                CurNum = i
                Exit For
            End If
        Next i
    Else
       Exit Sub
    End If
    With frmYH_Yetjb
        .lblKmmc.Caption = "科目：" & ArrYetjb(CurNum).Kmmc
        .lblJzrq.Caption = "对账截止日期：" & ArrYetjb(CurNum).JzRq
        .txtDwtzqye = Format(ArrYetjb(CurNum).Dwtzqye, "##,##0.00")
        .txtDwys = Format(ArrYetjb(CurNum).Dwys, "##,##0.00")
        .txtDwyf = Format(ArrYetjb(CurNum).Dwyf, "##,##0.00")
        .txtDwtzhye = Format(ArrYetjb(CurNum).Dwtzhye, "##,##0.00")
        .txtYhtzqye = Format(ArrYetjb(CurNum).Yhtzqye, "##,##0.00")
        .txtYhys = Format(ArrYetjb(CurNum).Yhys, "##,##0.00")
        .txtYhyf = Format(ArrYetjb(CurNum).Yhyf, "##,##0.00")
        .txtYhtzhye = Format(ArrYetjb(CurNum).Yhtzhye, "##,##0.00")
    End With
    frmYH_Yetjb.HelpContextID = 405
    frmYH_Yetjb.Show 1
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 mnuView_Click()
    Call Operate("VIEW")
End Sub

Private Sub tbr_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 "VIEW"
            Call mfgYetjbcx_DblClick
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Unload Me
    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
''        .DoSetPrintPara 1, 9, False          '设置A4纸张横向
''        .DoSetPrintRange 0, .Cols - 1, 0, .Rows - 1     '设置打印范围
       .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
''        .DoSetDefaultFont 9, 0, "宋体"
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
        
    'Title
        .SetCellAlign COL_START, ROW_TITLE, PageNo - 1, 36
''        .DoSetCellFont COL_START, ROW_TITLE, 18, 5, "黑体"
        .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_PAGENO, COL_END, ROW_PAGENO
''        .DoSetCellFont COL_START, ROW_PAGENO, 10, 0, "楷体_GB2312"
        .SetCellFont COL_START, ROW_PAGENO, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_PAGENO, PageNo - 1, 11
        .SetCellFontStyle COL_START, ROW_PAGENO, PageNo - 1, 0
        .SetCellAlign COL_START, ROW_PAGENO, PageNo - 1, 34
        
        .SetCellString COL_START, ROW_PAGENO, PageNo - 1, "总" + CStr(.GetTotalSheets) + "页 第 " & CStr(PageNo) & " 页"
    '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
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .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
        
        '设置内容
        .SetCellString COL_KMMC, ROW_HEAD1, PageNo - 1, "银行科目（账户）"
        .SetCellString COL_JZRQ, ROW_HEAD1, PageNo - 1, "对账截止日期"
        .SetCellString COL_BALANCE_DW, ROW_HEAD1, PageNo - 1, "单位账账面余额"
        .SetCellString COL_BALANCE_YH, ROW_HEAD1, PageNo - 1, "对账单账面余额"
        .SetCellString COL_BALANCE_END, ROW_HEAD1, PageNo - 1, "调整后余额"
        
    'Text
        For i = ROW_GRID_START To .GetRows(PageNo - 1) - 1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_KMMC, i, PageNo - 1, 33
            .SetCellAlign COL_JZRQ, i, PageNo - 1, 36
            .SetCellAlign COL_BALANCE_DW, i, PageNo - 1, 34
            .SetCellAlign COL_BALANCE_YH, i, PageNo - 1, 34
            .SetCellAlign COL_BALANCE_END, i, PageNo - 1, 34
        Next i
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
        
    'Draw Line
''        'Frame
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_KMMC, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_JZRQ, 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_BALANCE_DW, i
        .MergeCells COL_BALANCE_YH, i, COL_END, i
        .SetCellAlign COL_START, i, PageNo - 1, 33
        .SetCellAlign COL_BALANCE_YH, i, PageNo - 1, 34
''        .DoSetCellFont COL_START, i, 10, 0, "楷体_GB2312"
''        .DoSetCellFont COL_BALANCE_YH, i, 10, 0, "楷体_GB2312"
        .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_BALANCE_YH, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_BALANCE_YH, i, PageNo - 1, 11
        .SetCellFontStyle COL_BALANCE_YH, i, PageNo - 1, 0
        .SetCellString COL_START, i, PageNo - 1, "核算单位：" & sEnterName
        .SetCellString COL_BALANCE_YH, 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
    
    If Printers.Count = 0 Then
        MsgBox "未安装打印。", vbInformation
        Exit Sub
    End If
    With mfgYetjbcx
        For i = 1 To .Rows - 1
            lCount = lCount + 1
            Call AppendOneRow(ROW_GRID_START + lCount - 1, .TextMatrix(i, 0), _
                            .TextMatrix(i, 1), .TextMatrix(i, 2), _
                            .TextMatrix(i, 3), .TextMatrix(i, 4))
            If lCount = ROWS_PAGE And i <> .Rows - 1 Then
                lPage = lPage + 1
                frmP.CllR.InsertSheet frmP.CllR.GetTotalSheets, 1
                Call SetGrid(lPage, ROW_GRID_START + lCount)
                frmP.CllR.SetCurSheet lPage
                lCount = 0
            End If
        Next i
    End With
    
    lPage = lPage + 1
    Call SetGrid(lPage, 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 sKmmc As String, _
                ByVal sJzrq As String, ByVal sBalance_dw As String, _
                ByVal sBalance_yh As String, ByVal sBalance_end As String)
        
    With frmP.CllR
        .SetCellString COL_KMMC, i, .GetCurSheet, sKmmc
        .SetCellString COL_JZRQ, i, .GetCurSheet, sJzrq
        .SetCellString COL_BALANCE_DW, i, .GetCurSheet, sBalance_dw
        .SetCellString COL_BALANCE_YH, i, .GetCurSheet, sBalance_yh
        .SetCellString COL_BALANCE_END, i, .GetCurSheet, sBalance_end
    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