📄 -
字号:
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
'合计每行的数据形成本页合计
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 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
'格式化合计信息
If iShowAllCols = 0 Then
For i = LBound(sData) To UBound(sData)
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) = sData(i - 1, j) & s
End If
End If
If sData(i, j) = "合计:" Then
sData(i, iVsSumEndCol + 1) = "合计:"
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)
End If
Else
DY_Tybbyldy.Tydy = sTitle(UBound(sTitle), iVsSumEndCol) & ":" & sData(iPages(i - 1) + 1, iVsSumEndCol)
End If
Else
DY_Tybbyldy.Tydy = sTitle(UBound(sTitle), iVsSumEndCol) & ":" & sData(iPages(i - 1) + 1, iVsSumEndCol)
End If
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 _
Right(sData(m + iPages(i - 1) - 1, k + iColsPerPage(j - 1) - 1), 3) <> "合计:" Then
s = sData(m + iPages(i - 1) - 1, k + iColsPerPage(j - 1) - 1)
End If
End If
.TableCell(tcText, m, k) = Format(sData(m + iPages(i - 1) - 1, k + iColsPerPage(j - 1) - 1), iColFormat(k + iColsPerPage(j - 1)))
Next k
Next m
'填充合计信息
If iSumPerPage = 1 And UBound(sTotal) > 0 Then
.TableCell(tcRows) = .TableCell(tcRows) + 1
.TableCell(tcRowHeight, .TableCell(tcRows)) = iDataFontHeight + 100
For k = 1 To .TableCell(tcCols)
If iColType(k + iColsPerPage(j - 1)) = DATA_NUMERIC Then
.TableCell(tcAlign, .TableCell(tcRows), k) = 8 'RightMiddle
Else
.TableCell(tcAlign, .TableCell(tcRows), k) = 6 'LeftMiddle
End If
.TableCell(tcText, .TableCell(tcRows), k) = Format(sTotal(i - 1, k + iColsPerPage(j - 1) - 1), iColFormat(k + iColsPerPage(j - 1)))
Next k
If j = 1 Then
.TableCell(tcText, .TableCell(tcRows), 1) = "本页小计:"
End If
End If
.EndTable
Next j
Else '每行数据输出表头
For n = iPages(i - 1) + 1 To iPages(i) 'n为数据行
For j = LBound(iColsPerPage) + 1 To UBound(iColsPerPage) 'j为一个数据行分的断
.CurrentX = .MarginLeft
.CurrentY = .CurrentY + 100
.StartTable
'设置表格属性
.TableCell(tcRows) = UBound(sTitle) + 1 + 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 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
.TableCell(tcText, .TableCell(tcRows), k) = Format(sData(n, k + iColsPerPage(j - 1) - 1), iColFormat(k + iColsPerPage(j - 1) - 1))
Next k
.EndTable
Next j
'如果不是本页的最后一行并且后边没有本业合计,添加分隔线
If n <> iPages(i) Or iSumPerPage = 1 Then
.CurrentY = .CurrentY + 200
.CurrentX = .MarginLeft
.PenStyle = psDash
.DrawLine .CurrentX, .CurrentY, .PageWidth - .MarginRight, .CurrentY
.PenStyle = psSolid
End If
Next n
'添加本页合计信息
If iSumPerPage = 1 Then
For j = LBound(iColsPerPage) + 1 To UBound(iColsPerPage) 'j为一个数据行分的断
.CurrentX = .MarginLeft
.CurrentY = .CurrentY + 100
.StartTable
'设置表格属性
.TableCell(tcRows) = UBound(sTitle) + 1 + 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 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
.TableCell(tcText, .TableCell(tcRows), k) = Format(sTotal(i - 1, k + iColsPerPage(j - 1) - 1), iColFormat(k + iColsPerPage(j - 1)))
Next k
If j = LBound(iColsPerPage) + 1 Then
.TableCell(tcText, .TableCell(tcRows), 1) = "本页小计:"
End If
.EndTable
Next j
End If
End If
If i <> UBound(iPages) Then
.NewPage
End If
Next i
.EndDoc
DY_Tybbyldy.PageHScroll.Max = .Pagecount
DY_Tybbyldy.PageHScroll.Min = 1
DY_Tybbyldy.PageHScroll.Value = 1
End With
If bPrint = False Then
DY_Tybbyldy.Show 1
Else
DY_Tybbyldy.Tydy.PrintDoc
End If
Exit Function
ErrCtrl:
Set rs = Nothing
End Function
Public Function SetupPage(frmSetup As DY_Dyymsz, frmPrint As DY_Tybbyldy) As Boolean
Dim Tsxx As String
Dim Papername(1 To 70) As String
Papername(1) = "Letter, 8 1/2 x 11 英寸"
Papername(2) = "Letter Small, 8⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -