-

VB开发的ERP系统

    Dim iRowsPerPage As Long '每行显示数据行数
    Dim bLimitRowPerPage As Boolean '是否每页限制行数
    Dim iLimitRowsPerPage As Long '每页限制行数
    Dim iClientHeight As Long '页面可用高度
    Dim iPageLeft As Long '左边界
    Dim iClientWidth As Long '页面可用宽度
    Dim iPageTop As Long '上边界
    Dim iTitleFontHeight As Long '标题高度
    Dim iDataFontHeight As Long '数据高度
    
    With frmSetup
        sTitleFontName = .Btztlabel.Caption
        sDataFontName = .SjztLabel.Caption
        iTitleFontSize = Val(.Btzhlabel.Caption)
        iDataFontSize = Val(.Sjzhlabel.Caption)
        bLimitRowPerPage = .ZdhsCheck.Value
        iLimitRowsPerPage = Val(.BbhsText)
    End With
    With DY_Tybbyldy.Tydy
        .StartDoc
            .FontName = sTitleFontName
            .FontSize = iTitleFontSize
            .CalcText = "测试"
            iTitleFontHeight = .TextHei
            .FontName = sDataFontName
            .FontSize = iDataFontSize
            .CalcText = "测试"
            iDataFontHeight = .TextHei
        .EndDoc
        .KillDoc
        iPageHeight = .PageHeight
        iClientHeight = .PageHeight - .MarginBottom - .MarginTop
        iPageTop = .MarginTop
        iClientWidth = .PageWidth - .MarginLeft - .MarginRight
        iPageLeft = .MarginLeft
    End With
    
    '--------------------------------------------------打印参数完成-------------------------------------------------
    
    
    '--------------------------------------------------读取数据信息-------------------------------------------------
    '定义打印开始列
    If iShowAllCols = 1 Then
        iStartCol = iVsBeginCol
    Else
        iStartCol = iVsSumEndCol + 1
    End If
    
    '读取有效数据
    Dim sData() As String '网格表体数据
    Dim sTitle() As String '表头数据
    Dim iPages() As Long '打印分页信息,第i页结束行在sData()中的位置是iPages(i)
    Dim iTitleRows() As String '打印的表头行值
    Dim iDataRows() As String '打印的数据行值
    Dim iColsPerPage() As Long '每行在页面上的折行信息 第i行的结束列对应sData()中的iColsPerPage(i)列
    Dim iCols() As Long '需要打印的列值
    Dim iColWidth() As Long '需要打印的列款
    Dim iColType() As Long '需要打印的列数据类型
    Dim iColFormat() As String '需要打印的列格式
    With vs
        '读取有效列
        ReDim iCols(0)
        iCols(0) = 0
        ReDim iColWidth(0)
        iColWidth(0) = 0
        ReDim iColType(0)
        iColType(0) = 0
        ReDim iColFormat(0)
        iColFormat(0) = ""
        For i = 0 To .Cols - 1
            If Not .ColHidden(i) Then
                ReDim Preserve iCols(UBound(iCols) + 1)
                iCols(UBound(iCols)) = i
                ReDim Preserve iColWidth(UBound(iColWidth) + 1)
                If .ColWidth(i) >= iClientWidth Then
                    MsgBox "纸张宽度太小不能输出报表,请重新设置!", vbOKOnly + vbCritical
                    Exit Function
                End If
                iColWidth(UBound(iColWidth)) = .ColWidth(i)
                ReDim Preserve iColType(UBound(iColType) + 1)
                iColType(UBound(iColType)) = Val(.TextMatrix(0, i))
                ReDim Preserve iColFormat(UBound(iColFormat) + 1)
                iColFormat(UBound(iColFormat)) = .ColFormat(i)
            End If
        Next i
        If UBound(iCols) = 0 Then
            
            Exit Function
        End If
        '读取有效表头行
        ReDim iTitleRows(0)
        iTitleRows(0) = 0
        For i = 0 To .FixedRows - 1
            If .RowHidden(i) = False Then
                ReDim Preserve iTitleRows(UBound(iTitleRows) + 1)
                iTitleRows(UBound(iTitleRows)) = i
            End If
        Next i
        If UBound(iTitleRows) = 0 Then
            Exit Function
        End If
        
        '读取有效数据行
        ReDim iDataRows(0)
        iDataRows(0) = 0
        For i = .FixedRows To .Rows - 1
            If .RowHidden(i) = False Then
                ReDim Preserve iDataRows(UBound(iDataRows) + 1)
                iDataRows(UBound(iDataRows)) = i
            End If
        Next i
        If UBound(iDataRows) = 0 Then
            Exit Function
        End If
        
        '读取表头数据
        ReDim sTitle(UBound(iTitleRows) - 1, UBound(iCols) - 1)
        For i = LBound(iTitleRows) + 1 To UBound(iTitleRows)
            For j = LBound(iCols) + 1 To UBound(iCols)
                sTitle(i - LBound(iTitleRows) - 1, j - LBound(iCols) - 1) = .TextMatrix(iTitleRows(i), iCols(j))
            Next j
        Next i

        '读取表体数据
        ReDim sData(UBound(iDataRows) - 1, UBound(iCols) - 1)
        For i = LBound(iDataRows) + 1 To UBound(iDataRows)
            For j = LBound(iCols) + 1 To UBound(iCols)
                sData(i - LBound(iDataRows) - 1, j - LBound(iCols) - 1) = .TextMatrix(iDataRows(i), iCols(j))
            Next j
        Next i
        
        '--------------------------------------------------读取数据信息完成-------------------------------------------------
        
        '--------------------------------------------------计算打印信息-------------------------------------------------
        '计算数据行折行信息
        ReDim iColsPerPage(0)
        iColsPerPage(0) = iStartCol
        Dim iWidth As Long
        iWidth = 0
        For i = LBound(iColWidth) + 1 + iStartCol To UBound(iColWidth)
            
            iWidth = iWidth + iColWidth(i)
            If iWidth > iClientWidth Then
                iWidth = 0
                i = i - 1
                ReDim Preserve iColsPerPage(UBound(iColsPerPage) + 1)
                iColsPerPage(UBound(iColsPerPage)) = i
            End If
        Next i
        If iWidth <> 0 Then
            ReDim Preserve iColsPerPage(UBound(iColsPerPage) + 1)
            iColsPerPage(UBound(iColsPerPage)) = UBound(sData, 2) + 1
        End If
        
        '计算每页可以打印的行数
        If iSumPerPage = 1 Then
            i = 1
        Else
            i = 0
        End If
        j = UBound(sTitle) + 2
        If iPrintStyle = PRINTSTYLE_ONETITLE Then
            iRowsPerPage = (iClientHeight - iTitleFontHeight - iDataFontHeight - 1000) \ (UBound(iColsPerPage) * (iDataFontHeight + 100)) - i
        Else
            j = UBound(sTitle) + 2
            iRowsPerPage = (iClientHeight - iTitleFontHeight - iDataFontHeight - 1000) \ (UBound(iColsPerPage) * j * (iDataFontHeight + 250)) - i
        End If
        If bLimitRowPerPage = True Then
            If iRowsPerPage > iLimitRowsPerPage Then
                iRowsPerPage = iLimitRowsPerPage
            End If
        End If
        
        '计算分页信息
        ReDim iPages(0)
        iPages(0) = -1
        If iVsSumEndCol = -1 Or iSplitPage = 0 Then '如果没有分页情况,只需判断本页最多能够打印的行数
            For i = LBound(sData) To UBound(sData)
                If i Mod iRowsPerPage = iRowsPerPage - 1 Then
                    ReDim Preserve iPages(UBound(iPages) + 1)
                    iPages(UBound(iPages)) = i
                End If
            Next i
        Else
        '如果有分页情况,则首先判断是否是分页行,然后循环判断下边的行
        '如果是合计行则加入本页(在数据行数小于可打印行数的情况下)
            For i = LBound(sData) To UBound(sData) '数据行数达到最大行
                
                If (i - iPages(UBound(iPages))) Mod iRowsPerPage = 0 And i <> 0 Then
                    ReDim Preserve iPages(UBound(iPages) + 1)
                    iPages(UBound(iPages)) = i
                    If Len(sData(i, iVsSumEndCol)) >= 3 Then
                        s = Right(sData(i, iVsSumEndCol), 3)
                    Else
                        s = ""
                    End If
                        
                    If s = "合计:" Or s = "小计:" Then
                        bSumRow = True
                    End If
                Else '合计分页
                    If Len(sData(i, iVsSumEndCol)) >= 3 Then
                        s = Right(sData(i, iVsSumEndCol), 3)
                    Else
                        s = ""
                    End If
                    If s = "合计:" Or s = "小计:" Or bSumRow = True Then
                        bNext = False
                        bSumRow = False
                        If iVsSumEndCol = 0 Then
                            ReDim Preserve iPages(UBound(iPages) + 1)
                            iPages(UBound(iPages)) = i
                        Else
                            
                            For j = iVsSumEndCol To iVsBeginCol + 1 Step -1
                                If Len(sData(i + 1, j - 1)) >= 3 Then
                                    s = Right(sData(i + 1, j - 1), 3)
                                Else
                                    s = ""
                                End If
                                If s = "合计:" Or s = "小计:" Then
                                    bNext = True
                                    i = i + 1
                                    '如果当前行达到最大行,分页
                                    If (i - iPages(UBound(iPages))) Mod iRowsPerPage = 0 Then
                                        ReDim Preserve iPages(UBound(iPages) + 1)
                                        iPages(UBound(iPages)) = i
                                        bNext = False
                                    End If
                                End If
                            Next j
                            '如果到了第0列,分页
                            If j = iVsBeginCol Then
                                ReDim Preserve iPages(UBound(iPages) + 1)
                                iPages(UBound(iPages)) = i
                            End If
                        End If
                        '因为如果bNext=true 则数据行多移动了一行,减去
                        If bNext = True Then
                            i = i - 1
                        End If
                        '判断起始列的合计情况
                        bNext = False
                        Do While True
                            If i < UBound(sData) Then
                                If Len(sData(i + 1, iVsBeginCol)) >= 3 Then
                                    s = Right(sData(i + 1, iVsBeginCol), 3)
                                Else
                                    s = ""
                                End If
                                If s = "小计:" Or s = "合计:" Then
                                    i = i + 1
                                    bNext = True
                                Else
                                    Exit Do
                                End If
                            Else
                                Exit Do
                            End If
                        Loop
                        If bNext = True Then
                            ReDim Preserve iPages(UBound(iPages) + 1)
                            iPages(UBound(iPages)) = i
                        End If
                    End If
                End If
            Next i
        End If
        '剩下的行也要占一页
        If iPages(UBound(iPages)) <> UBound(sData) Then
            ReDim Preserve iPages(UBound(iPages) + 1)
            iPages(UBound(iPages)) = UBound(sData)
        End If
            
    End With
'    如果某页的行数为0则删除列,上面的分页程序繁琐,有时候会造成某页的数据行为0
'    的情况,在此进行处理,有必要重新考虑分页的程序结构???
    Dim iPagesB() As Long
    ReDim iPagesB(0)
    iPagesB(0) = iPages(0)
    For i = 1 To UBound(iPages)
        If iPages(i) <> iPages(i - 1) Then
            ReDim Preserve iPagesB(UBound(iPagesB) + 1)
            iPagesB(UBound(iPagesB)) = iPages(i)
        End If
    Next i
    ReDim iPages(UBound(iPagesB))
    iPages = iPagesB

    '合计每行的数据形成本页合计
    Dim sTotal() As String
    ReDim sTotal(0, 0)
    If iSumPerPage = 1 Then
        If UBound(iPages) >= 1 Then
            ReDim sTotal(UBound(iPages) - 1, UBound(sData, 2))
            For i = 0 To UBound(sTotal) '行
                For j = LBound(iCols) + 1 To UBound(iCols) '列
                    If iColType(j) = DATA_NUMERIC Then
                        For n = iPages(i) + 1 To iPages(i + 1)
                            bNext = False
                            '合计行的信息不加入本页合计
                            For m = iVsBeginCol To IIf(iVsSumEndCol = -1, 0, iVsSumEndCol)
                                If Len(sData(n, m)) >= 3 Then
                                    s = Right(sData(n, m), 3)