gibt es eine Möglichkeit, die letzte Zeile vor der Fußzeile per VBA zu ermitteln?
Danke und Gruß
Sub Seitenumbruch()
Dim varpb As Variant
Dim ipage As Integer, irowl As Integer
irowl = Cells(Rows.Count, 1).End(xlUp).Row
ipage = 1
Do While IsError(varpb) = False
varpb = ExecuteExcel4Macro("index(get.document(64)," & ipage & ")")
If Not IsError(varpb) Then Cells(varpb - 4, 1).Select
If Not IsError(varpb) Then varpb1 = varpb - 4
If Not IsError(varpb) Then Rows(varpb1).RowHeight = 53
If Not IsError(varpb) Then ActiveSheet.OLEObjects.Add(Filename:="B:\Fußzeile.doc", Link:=False, _
DisplayAsIcon:=False).Select
If IsError(varpb) Then
GoTo ende: 'exit sub
Else
Cells(varpb - 1, 2) = Application.Sum(Range(Cells(1, 1), Cells(varpb - 1, 1)))
End If
ipage = ipage + 1
Cells(irowl, 2) = Application.Sum(Cells(1, 1), Cells(irowl, 1))
Loop
ende:
Range(1, 1).Select
End Sub
Sub Seitenumbruch()
Dim varpb As Variant
Dim ipage As Integer, irowl As Integer
irowl = Cells(Rows.Count, 1).End(xlUp).Row
ipage = 1
Do While IsError(varpb) = False
varpb = ExecuteExcel4Macro("index(get.document(64)," & ipage & ")")
If Not IsError(varpb) Then Cells(varpb - 4, 1).Select
If Not IsError(varpb) Then varpb1 = varpb - 4
If Not IsError(varpb) Then Rows(varpb1).RowHeight = 53
If Not IsError(varpb) Then ActiveSheet.OLEObjects.Add(Filename:="B:\Fußzeile.doc", Link:=False, _
DisplayAsIcon:=False).Select
If IsError(varpb) Then
GoTo ende: 'exit sub
Else
Cells(varpb - 1, 2) = Application.Sum(Range(Cells(1, 1), Cells(varpb - 1, 1)))
End If
ipage = ipage + 1
'***Cells(irowl, 2) = Application.Sum(Cells(1, 1), Cells(irowl, 1))' ***das hier ersetzen***
Loop
ende:
Range(1, 1).Select
End Sub
Sub Seitenumbruch()
Dim varpb As Variant
Dim ipage As Integer, irowl As Integer
ipage = 1
irowl = ActiveSheet.UsedRange.Rows.Count
Do While IsError(varpb) = False
varpb = ExecuteExcel4Macro("index(get.document(64)," & ipage & ")")
If Not IsError(varpb) Then Cells(varpb - 4, 1).Select
If Not IsError(varpb) Then varpb1 = varpb - 4
If Not IsError(varpb) Then Rows(varpb1).RowHeight = 53
If Not IsError(varpb) Then ActiveSheet.OLEObjects.Add(Filename:="B:\Fußzeile.doc", Link:=False, _
DisplayAsIcon:=False).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 1
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 1
Selection.ShapeRange.Line.Visible = msoFalse
If IsError(varpb) Then
GoTo ende: 'exit sub
Else
End If
ipage = ipage + 1
varpb12 = varpb - 3
Loop
ende:
irowl12 = irowl
While Not irowl12 = varpb12
hoch = hoch + Rows(irowl12).RowHeight
irowl12 = irowl12 - 1
Wend
While Not irowl12 = varpb12 + 100
Rows(irowl12).RowHeight = 13.2
irowl12 = irowl12 + 1
Wend
hoch1 = 739 - hoch - 75
hoch1 = Round(hoch1)
If hoch1 < 0 Then GoTo ende1:
If hoch1 > 409 Then Rows(irowl + 1).RowHeight = hoch1 - 409
If hoch1 > 409 Then hoch1 = hoch1 - 409
If hoch1 + 53 > 409 Then Rows(irowl + 2).RowHeight = hoch1
If hoch1 + 53 > 409 Then irowl = irowl + 1
If hoch1 + 53 > 409 Then hoch1 = 1
Rows(irowl + 1).RowHeight = hoch1
Rows(irowl + 2).RowHeight = 53
Rows(irowl + 2).Select
ActiveSheet.OLEObjects.Add(Filename:="B:\Fußzeile.doc", Link:=False, _
DisplayAsIcon:=False).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 1
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 1
Selection.ShapeRange.Line.Visible = msoFalse
ende1:
MsgBox "Bitte letzte Seite von Hand formatieren bzw. zusätzliche Zeilen einfügen und das Umbruchmakro neu starten"
Exit Sub
End Sub