frmyh_yhdzcx.frm

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

             .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_RQ, i, PageNo - 1, 36
            .SetCellAlign COL_JSFS_YH, i, PageNo - 1, 33
            .SetCellAlign COL_BILL_NUMBER_YH, i, PageNo - 1, 33
            .SetCellAlign COL_DEBIT_MONEY_YH, i, PageNo - 1, 34
            .SetCellAlign COL_CREDIT_MONEY_YH, i, PageNo - 1, 34
            .SetCellAlign COL_LQBZ_YH, i, PageNo - 1, 36
            .SetCellAlign COL_ZY, i, PageNo - 1, 33
        Next i
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
        
    'Draw Line
        .DrawGridLine COL_START_YH, ROW_HEAD1, COL_END_YH, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_RQ, ROW_HEAD1, COL_END_YH, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_JSFS_YH, ROW_HEAD1, COL_END_YH, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .SetRows .GetRows(PageNo - 1) + 1, PageNo - 1
        i = .GetRows(PageNo - 1) - 1
        .MergeCells COL_START_YH, i, COL_DEBIT_MONEY_YH, i
        .MergeCells COL_CREDIT_MONEY_YH, i, COL_END_YH, i
        .SetCellAlign COL_START_YH, i, PageNo - 1, 33
        .SetCellAlign COL_CREDIT_MONEY_YH, i, PageNo - 1, 34
        .SetCellFont COL_START_YH, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START_YH, i, PageNo - 1, 10
        .SetCellFontStyle COL_START_YH, i, PageNo - 1, 0
        .SetCellFont COL_CREDIT_MONEY_YH, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_CREDIT_MONEY_YH, i, PageNo - 1, 10
        .SetCellFontStyle COL_CREDIT_MONEY_YH, i, PageNo - 1, 0
        .SetCellString COL_START_YH, i, PageNo - 1, "核算单位：" & sEnterName
        .SetCellString COL_CREDIT_MONEY_YH, i, PageNo - 1, "打印日期：" & Format(Date, "yyyy-mm-dd")
        .ShowPageBreak False
    End With

End Sub

'设置单位日记账打印表格
Private Sub SetGrid_DW(ByVal PageNo As Long, ByVal sTitle As String, 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_DW + 2, PageNo - 1
        .PrintSetMargin 10, 10, 10, 10
        .PrintSetOrient 1
        .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
        .SetSelectMode PageNo - 1, 2
        .WorkbookReadonly = True
        .AllowSizeColInGrid = True
    'Title
        .SetCellAlign COL_START_DW, ROW_TITLE, PageNo - 1, 36
        .SetCellFont COL_START_DW, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START_DW, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START_DW, ROW_TITLE, PageNo - 1, 10
        .MergeCells COL_START_DW, ROW_TITLE, COL_END_DW, ROW_TITLE
        .SetCellString COL_START_DW, ROW_TITLE, PageNo - 1, "单位日记账" & sTitle
        .SetRowHeight 1, 40, ROW_TITLE, PageNo - 1
    'Comment
        .MergeCells COL_START_DW, ROW_SUBJNAME, COL_DEBIT_MONEY_DW, ROW_SUBJNAME
        .MergeCells COL_CREDIT_MONEY_DW, ROW_SUBJNAME, COL_END_DW, ROW_SUBJNAME
        
        .SetCellFont COL_START_DW, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START_DW, ROW_SUBJNAME, PageNo - 1, 10
        .SetCellFontStyle COL_START_DW, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellAlign COL_CREDIT_MONEY_DW, ROW_SUBJNAME, PageNo - 1, 34
        .SetCellFont COL_CREDIT_MONEY_DW, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_CREDIT_MONEY_DW, ROW_SUBJNAME, PageNo - 1, 10
        .SetCellFontStyle COL_CREDIT_MONEY_DW, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellString COL_START_DW, ROW_SUBJNAME, PageNo - 1, "银行科目：" & cboKmmc.List(cboKmmc.ListIndex)
        .SetCellString COL_CREDIT_MONEY_DW, ROW_SUBJNAME, PageNo - 1, "第 " & CStr(PageNo) & " 页"
    'Head
        For i = ROW_HEAD1 To ROW_HEAD1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START_DW To COL_END_DW
                .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, 10
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
        Next i
        
        '设置列宽
        iColWidth = GetColWidth(COLWIDTH_DW)
        For i = LBound(iColWidth) To UBound(iColWidth)
            .SetColWidth 1, iColWidth(i), i + 1, PageNo - 1
        Next i
        .SetColWidth 1, 1, COL_END_DW + 1, PageNo - 1
        
        '设置内容
        .SetCellString COL_PZRQ, ROW_HEAD1, PageNo - 1, "凭证日期"
        .SetCellString COL_BILL_DATE, ROW_HEAD1, PageNo - 1, "票据日期"
        .SetCellString COL_JSFS_DW, ROW_HEAD1, PageNo - 1, "结算方式"
        .SetCellString COL_BILL_NUMBER_DW, ROW_HEAD1, PageNo - 1, "票号"
        .SetCellString COL_DEBIT_MONEY_DW, ROW_HEAD1, PageNo - 1, "借方金额"
        .SetCellString COL_CREDIT_MONEY_DW, ROW_HEAD1, PageNo - 1, "贷方金额"
        .SetCellString COL_LQBZ_DW, ROW_HEAD1, PageNo - 1, "两清标志"
        .SetCellString COL_PZZL, ROW_HEAD1, PageNo - 1, "凭证种类"
        .SetCellString COL_PZBH, ROW_HEAD1, PageNo - 1, "凭证编号"
        .SetCellString COL_PZZY, ROW_HEAD1, PageNo - 1, "摘要"
    'Text
        For i = ROW_GRID_START To .GetRows(PageNo - 1) - 1
        .SetRowHeight 1, 20, i, PageNo - 1
            For j = COL_START_DW To COL_END_DW
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 10
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_PZRQ, i, PageNo - 1, 36
            .SetCellAlign COL_BILL_DATE, i, PageNo - 1, 36
            .SetCellAlign COL_JSFS_DW, i, PageNo - 1, 33
            .SetCellAlign COL_BILL_NUMBER_DW, i, PageNo - 1, 33
            .SetCellAlign COL_DEBIT_MONEY_DW, i, PageNo - 1, 34
            .SetCellAlign COL_CREDIT_MONEY_DW, i, PageNo - 1, 34
            .SetCellAlign COL_LQBZ_DW, i, PageNo - 1, 36
            .SetCellAlign COL_PZZL, i, PageNo - 1, 36
            .SetCellAlign COL_PZBH, i, PageNo - 1, 36
            .SetCellAlign COL_PZZY, i, PageNo - 1, 33
        Next i
        .MergeCells .GetCols(.GetCurSheet) - 1, ROW_HEAD1, .GetCols(.GetCurSheet) - 1, .GetRows(.GetCurSheet) - 1
        
    'Draw Line
''        'Frame
        .DrawGridLine COL_START_DW, ROW_HEAD1, COL_END_DW, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_PZRQ, ROW_HEAD1, COL_END_DW + 1, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_BILL_DATE, ROW_HEAD1, COL_END_DW + 1, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)

        .SetRows .GetRows(PageNo - 1) + 1, PageNo - 1
        i = .GetRows(PageNo - 1) - 1
        .MergeCells COL_START_DW, i, COL_BILL_NUMBER_DW, i
        .MergeCells COL_DEBIT_MONEY_DW, i, COL_END_DW, i
        .SetCellAlign COL_START_DW, i, PageNo - 1, 33
        .SetCellAlign COL_DEBIT_MONEY_DW, i, PageNo - 1, 34
        .SetCellFont COL_START_DW, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START_DW, i, PageNo - 1, 10
        .SetCellFontStyle COL_START_DW, i, PageNo - 1, 0
        .SetCellFont COL_DEBIT_MONEY_DW, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_DEBIT_MONEY_DW, i, PageNo - 1, 10
        .SetCellFontStyle COL_DEBIT_MONEY_DW, i, PageNo - 1, 0
        .SetCellString COL_START_DW, i, PageNo - 1, "核算单位：" & sEnterName
        .SetCellString COL_DEBIT_MONEY_DW, i, PageNo - 1, "打印日期：" & Format(Date, "yyyy-mm-dd")
        .ShowPageBreak False
    End With

End Sub

'显示打印结果
Private Sub ShowPrintResult(ByVal sPrtStr As String)
    If Printers.Count = 0 Then
       MsgBox "请安置打印机！", vbInformation
       Exit Sub
    End If
    If IsChangeCurrentTable Then
        Unload frmP
        IsChangeCurrentTable = False
        Call DrawCellTable
    End If
    
    Me.Hide
'    frmP.Show
    If sPrtStr = "PRINT" Then
       frmP.Cllr.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
       frmP.uPrint
    Else
        frmP.Cllr.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        frmP.uPreview
    End If
    Me.Show 1
End Sub


'向表格中追加一行
Private Sub AppendOneRow_YH(ByVal i As Long, ByVal sRq As String, ByVal sJsfs As String, _
        ByVal sBill_Number As String, ByVal sDebit_Money As String, _
        ByVal sCredit_Money As String, ByVal sLqbz As String, ByVal sZy As String)
        
    With frmP.Cllr
        .SetCellString COL_RQ, i, .GetCurSheet, sRq
        .SetCellString COL_JSFS_YH, i, .GetCurSheet, sJsfs
        .SetCellAlign COL_JSFS_YH, i, .GetCurSheet, 33
        .SetCellString COL_BILL_NUMBER_YH, i, .GetCurSheet, sBill_Number
        .SetCellAlign COL_BILL_NUMBER_YH, i, .GetCurSheet, 33
        .SetCellString COL_DEBIT_MONEY_YH, i, .GetCurSheet, sDebit_Money
        .SetCellString COL_CREDIT_MONEY_YH, i, .GetCurSheet, sCredit_Money
        .SetCellString COL_LQBZ_YH, i, .GetCurSheet, sLqbz
        .SetCellString COL_ZY, i, .GetCurSheet, sZy
    End With
    
End Sub

'向表格中追加一行
Private Sub AppendOneRow_DW(ByVal i As Long, ByVal sPzrq As String, _
        ByVal sBill_Date As String, ByVal sJsfs As String, _
        ByVal sBill_Number As String, ByVal sDebit_Money As String, _
        ByVal sCredit_Money As String, ByVal sLqbz As String, _
        ByVal sPZZL As String, ByVal sPZBH As String, _
        ByVal sPzzy As String)
        
    With frmP.Cllr
        .SetCellString COL_PZRQ, i, .GetCurSheet, sPzrq
        .SetCellString COL_BILL_DATE, i, .GetCurSheet, sBill_Date
        .SetCellString COL_JSFS_DW, i, .GetCurSheet, sJsfs
        .SetCellAlign COL_JSFS_DW, i, .GetCurSheet, 33
        .SetCellString COL_BILL_NUMBER_DW, i, .GetCurSheet, sBill_Number
        .SetCellAlign COL_BILL_NUMBER_DW, i, .GetCurSheet, 33
        .SetCellString COL_DEBIT_MONEY_DW, i, .GetCurSheet, sDebit_Money
        .SetCellString COL_CREDIT_MONEY_DW, i, .GetCurSheet, sCredit_Money
        .SetCellString COL_LQBZ_DW, i, .GetCurSheet, sLqbz
        .SetCellString COL_PZZL, i, .GetCurSheet, sPZZL
        .SetCellString COL_PZBH, i, .GetCurSheet, sPZBH
        .SetCellString COL_PZZY, i, .GetCurSheet, sPzzy
    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

'根据MSFLEXGRID表格生成CELL表格
Private Sub DrawCellTable()
    Dim sTitle As String
    Dim lPage As Long
    Dim lCount As Long
    Dim i As Long
    Dim j As Long
    
    Set frmP = New frmPrint
    Select Case stbYhdzcx.Tab
        Case 0
            With frmP.Cllr
                .ResetContent
                .SetCols COL_END_YH + 2, 0
                .SetRows ROW_GRID_START + ROWS_PAGE_YH, 0
            End With
        Case 1
            With frmP.Cllr
                .ResetContent
                .SetCols COL_END_DW + 2, 0
                .SetRows ROW_GRID_START + ROWS_PAGE_DW, 0
            End With
    End Select
    Select Case cboViewselect.ListIndex
        Case 0
            sTitle = "（全部）"
        Case 1
            sTitle = "（已达）"
        Case 2
            sTitle = "（未达）"
    End Select
    lPage = 0
    lCount = 0
    
    Select Case stbYhdzcx.Tab
        Case 0
            With mfgYhdzd
                For i = 1 To .Rows - 1
                    lCount = lCount + 1
                    Call AppendOneRow_YH(ROW_GRID_START + lCount - 1, .TextMatrix(i, 0), _
                        .TextMatrix(i, 1), .TextMatrix(i, 2), .TextMatrix(i, 3), _
                        .TextMatrix(i, 4), .TextMatrix(i, 5), .TextMatrix(i, 6))
                    If lCount Mod ROWS_PAGE_YH = 0 And i <> .Rows - 1 Then
                        lPage = lPage + 1
                        frmP.Cllr.InsertSheet frmP.Cllr.GetTotalSheets, 1
                        Call SetGrid_YH(lPage, sTitle, ROW_GRID_START + lCount)
                        frmP.Cllr.SetCurSheet lPage
                        lCount = 0
                    End If
                Next i
            End With
            lPage = lPage + 1
            Call SetGrid_YH(lPage, sTitle, ROW_GRID_START + lCount)
            For i = 0 To frmP.Cllr.GetTotalSheets - 1
                frmP.Cllr.SetCellString COL_CREDIT_MONEY_YH, ROW_SUBJNAME, i, "总" + CStr(frmP.Cllr.GetTotalSheets) + "页 第 " & CStr(i + 1) & " 页"
            Next
            frmP.Cllr.SetCurSheet 0
        Case 1
            With mfgDwrjz
                For i = 1 To .Rows - 1
                    lCount = lCount + 1