AW: Siehe Worksheet.ExportAsFixedFormat-Methode owT
07.07.2016 10:25:50
Bark
Ja, das habe ich auch versucht, aber die Zwischensumme macht er nur für die 1. Seite. In den Folgeseiten fehlen die Überträge und die Zwischensumme in der Kopf- und Fusszeilen der PDF-Datei.
Hier mein Code:
Sub Seitenumbruch()
Dim varPB As Variant
Dim iPage As Integer, iRowL As Integer
Dim dSumA As Currency, dSumB As Currency
iRowL = Cells(Rows.Count, 6).End(xlUp).Row
iPage = 1
Do Until IsError(varPB)
varPB = ExecuteExcel4Macro( _
"INDEX(GET.DOCUMENT(64)," & iPage & ")")
If IsError(varPB) Then Exit Do
dSumA = WorksheetFunction.Sum(Range(Cells(1, 6), Cells(varPB - 1, 6)))
If iPage = 1 Then
With ActiveSheet.PageSetup
.RightHeader = ""
.RightFooter = "&""Verdana,Fett""Zwischensumme: " & Format(dSumA, "#,##0.00"" " _
"")
End With
Else
With ActiveSheet.PageSetup
.RightHeader = "&""Verdana,Fett""Übertrag: " & Format(dSumB, "#,##0.00"" """)
.RightFooter = "&""Verdana,Fett""Zwischensumme: " & Format(dSumA, "#,##0.00"" " _
"")
End With
End If
ActiveSheet.PrintOut From:=iPage, To:=iPage
dSumB = dSumA
iPage = iPage + 1
Loop
dSumB = dSumA
dSumA = WorksheetFunction.Sum(Range(Cells(1, 6), Cells(iRowL, 6)))
If iPage = 1 Then
With ActiveSheet.PageSetup
.RightHeader = ""
.RightFooter = ""
End With
Else
With ActiveSheet.PageSetup
.RightHeader = "&""Verdana,Fett""Übertrag: " & Format(dSumB, "#,##0.00"" """)
.RightFooter = ""
End With
End If
ActiveSheet.PrintOut From:=iPage, To:=iPage
With ActiveSheet.PageSetup
.RightHeader = ""
.RightFooter = ""
End With
End Sub