📄 -
字号:
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)
Else
s = ""
End If
If s = "合计:" Or s = "小计:" Then
bNext = True
Exit For
End If
Next m
If bNext = False Then
sTotal(i, j - 1) = Val(sTotal(i, j - 1)) + Val(Replace(sData(n, j - 1), ",", ""))
End If
Next n
End If
Next j
Next i
End If
End If
'格式化合计信息
bNext = False
If iShowAllCols = 0 Then
For i = LBound(sData) To UBound(sData)
If bNext = True Then
Exit For
End If
For j = iVsSumEndCol To LBound(sData, 2) Step -1
If Len(sData(i, j)) >= 3 Then
s = Right(sData(i, j), 3)
Else
s = ""
End If
If s = "小计:" Then
If i - 1 >= 0 Then
sData(i, iVsSumEndCol + 1) = Replace(sData(i - 1, j), s, "") & s
Else
bNext = True
Exit For
End If
End If
If sData(i, j) = "合计:" Then
sData(i, iVsSumEndCol + 1) = "合计:"
End If
Next j
Next i
End If
If bNext = True Then
For i = LBound(sData) To UBound(sData)
For j = iVsSumEndCol To LBound(sData, 2) Step -1
If sData(i, j) <> "" Then
If sData(i, j) = "合计:" Then
sData(i, iVsSumEndCol + 1) = sData(i, j)
Else
sData(i, iVsSumEndCol + 1) = Replace(sData(i, j), "小计:", "") & "小计:"
End If
Exit For
End If
Next j
Next i
End If
'--------------------------------------------------计算打印信息完毕-------------------------------------------------
'--------------------------------------------------打印数据-------------------------------------------------
'输送数据
Dim dy As Long
dy = 0
With DY_Tybbyldy.Tydy
.StartDoc
For i = LBound(iPages) + 1 To UBound(iPages)
.FontName = sTitleFontName
.FontSize = iTitleFontSize
.CalcText = sRTitle
.CurrentX = (iClientWidth - .TextWid) / 2 + iPageLeft
.CurrentY = iPageTop
DY_Tybbyldy.Tydy = sRTitle
.CurrentX = (iClientWidth - .TextWid) / 2 + iPageLeft - 500
.CurrentY = .CurrentY + 100
.CalcText = sRTitle
.DrawLine .CurrentX, .CurrentY, (iClientWidth + .TextWid) / 2 + iPageLeft + 500, .CurrentY
.CurrentY = .CurrentY + 200
.CurrentX = .MarginLeft
.FontName = sDataFontName
.FontSize = iDataFontSize
dy = .CurrentY
'打印分组信息
If iSplitPage = 1 And iVsSumEndCol <> -1 Then
If Len(sData(iPages(i - 1) + 1, iVsSumEndCol)) >= 3 Then
If Right(sData(iPages(i - 1) + 1, iVsSumEndCol), 3) = "小计:" Then
If iPages(i - 1) >= 0 Then
DY_Tybbyldy.Tydy = sTitle(UBound(sTitle), iVsSumEndCol) & ":" & sData(iPages(i - 1) + 1 - 1, iVsSumEndCol) & Space(10) & sSubTitle
End If
Else
DY_Tybbyldy.Tydy = sTitle(UBound(sTitle), iVsSumEndCol) & ":" & sData(iPages(i - 1) + 1, iVsSumEndCol) & Space(10) & sSubTitle
End If
Else
DY_Tybbyldy.Tydy = sTitle(UBound(sTitle), iVsSumEndCol) & ":" & sData(iPages(i - 1) + 1, iVsSumEndCol) & Space(10) & sSubTitle
End If
Else
DY_Tybbyldy.Tydy = sSubTitle
End If
.CurrentX = .PageWidth - .MarginRight - .TextWidth("第100页 共100页 ")
.CurrentY = dy
DY_Tybbyldy.Tydy = "第" & i & "页 共" & UBound(iPages) & "页 "
If iPrintStyle = PRINTSTYLE_ONETITLE Then '只输出一个表头
For j = LBound(iColsPerPage) + 1 To UBound(iColsPerPage)
.CurrentX = .MarginLeft
.CurrentY = .CurrentY + 100
.StartTable
'设置表格属性
.TableCell(tcRows) = iPages(i) - iPages(i - 1) + UBound(sTitle) + 1
.TableCell(tcCols) = iColsPerPage(j) - iColsPerPage(j - 1)
For m = 1 To .TableCell(tcRows) '行高
.TableCell(tcRowHeight, m) = iDataFontHeight + 100
Next m
For m = 1 To .TableCell(tcCols) '列宽
.TableCell(tcColWidth, , m) = iColWidth(m + iColsPerPage(j - 1))
Next m
'填充表头
For m = 1 To UBound(sTitle) + 1
For k = 1 To .TableCell(tcCols)
.TableCell(tcAlign, m, k) = 6
.TableCell(tcText, m, k) = Trim(sTitle(m - 1, k + iColsPerPage(j - 1) - 1))
.CalcText = .TableCell(tcText, m, k)
If (.TableCell(tcColWidth, , k) - .TextWid - 100) > 0 Then
.TableCell(tcText, m, k) = Space((.TableCell(tcColWidth, , k) - .TextWid - 100) / .TextWidth("测试")) & .TableCell(tcText, m, k)
End If
Next k
Next m
'填充数据
For m = UBound(sTitle) + 1 + 1 To .TableCell(tcRows)
For k = 1 To .TableCell(tcCols)
If iColType(k + iColsPerPage(j - 1)) = DATA_NUMERIC Then
.TableCell(tcAlign, m, k) = 8 'RightMiddle
Else
.TableCell(tcAlign, m, k) = 6 'LeftMiddle
End If
If Len(sData(m + iPages(i - 1) - 1, k + iColsPerPage(j - 1) - 1)) >= 3 Then
If Right(sData(m + iPages(i - 1) - 1, k + iColsPerPage(j - 1) - 1), 3) <> "小计:" And _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -