Hallo zusammen,

ich möchte mit dem folgenden Code Daten auf eine Seite drucken und dabei die Seite voll ausnutzen.
Der Code wird über eine Schaltfläche aufgerufen.
Der Teil des Codes mit dem ich die Zeilenhöhe verändere, funktioniert aber nicht immer.
Nur bei jedem zweiten Aufruf wird die Änderung durchgeführt, ansonsten bleibt die ursprüngliche Zeilenhöhe.
Was ist zu tun?

Gruß
Siegfried

Sub Kalenderdruck_Rückserie_Hochformat_Seite6()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim n1 As Integer, AnzZeilen As Integer
Dim Zeilenhöhe As Double, Spaltenbreite As Double
Dim Spalte1 As Integer, Spalte2 As Integer
Dim Startspalte As Integer
Dim Startzelle As Range, Nachbarzelle As Range
Dim SpaltenbreiteMax As Integer
Dim AnzBelegung As Integer, Zähler As Integer
Dim angepassteHöhe As Double, angepassteBreite As Double
Dim Anpassungsfaktor As Double
Dim HöheAnpassungswert As Double, BreiteAnpassungswert As Double
Dim Bereich As Range

AnzZeilen = (31 * 5) + (6 * 5)
' DIN A4 (Höhe 844 Pixel / Breite 97 Pixel = Anpassungsfaktor 8.7)
Anpassungsfaktor = 8.7

Spalte1 = Range("Monat.Sep").Column
Spalte2 = Range("Monat.Nov").Column

Startspalte = Spalte2
Set Startzelle = Range("Tag1.Nov")
Set Nachbarzelle = Range("Tag1.Sep")

For n1 = 0 To AnzZeilen
Zeilenhöhe = Zeilenhöhe + Startzelle.Offset(n1, 0).RowHeight
Next n1
For n1 = 0 To 9
Spaltenbreite = Spaltenbreite + Startzelle.Offset(0, n1).ColumnWidth
Next n1
angepassteHöhe = Spaltenbreite * Anpassungsfaktor
angepassteBreite = Zeilenhöhe / Anpassungsfaktor

SpaltenbreiteMax = 0
If Startzelle.Offset(0, 2).ColumnWidth > SpaltenbreiteMax Then
SpaltenbreiteMax = Startzelle.Offset(0, 2).ColumnWidth
End If
If Startzelle.Offset(0, 7).ColumnWidth > SpaltenbreiteMax Then
SpaltenbreiteMax = Startzelle.Offset(0, 7).ColumnWidth
End If
AnzBelegung = 0
Zähler = 0
For n1 = 0 To AnzZeilen
' hier ist ein Termin eingetragen
If Startzelle.Offset(n1, 4).Value > "" Or _
Startzelle.Offset(n1, 9).Value > "" Then
Zähler = Zähler + 1
' stellt die Zeilenhöhe auf den Ausgangszustand
Startzelle.Offset(n1, 0).RowHeight = ZeilenhöheTermin
End If
If Nachbarzelle.Offset(n1, 4).Value > "" Or _
Nachbarzelle.Offset(n1, 9).Value > "" Then
' stellt die Zeilenhöhe auf den Ausgangszustand
Nachbarzelle.Offset(n1, 0).RowHeight = ZeilenhöheTermin
End If
Next n1
If Zähler > AnzBelegung Then
AnzBelegung = Zähler
End If

' stellt die Spaltenbreite auf den Ausgangszustand
Columns(Spalte1 + 2).AutoFit
Columns(Spalte1 + 7).AutoFit
Columns(Spalte2 + 2).AutoFit
Columns(Spalte2 + 7).AutoFit
HöheAnpassungswert = (angepassteHöhe - Zeilenhöhe) / AnzBelegung

' passt die Zeilenhöhe an
For n1 = 0 To AnzZeilen
If Startzelle.Offset(n1, 4).Value > "" Or _
Startzelle.Offset(n1, 9).Value > "" Then
Startzelle.Offset(n1, 0).RowHeight = ZeilenhöheTermin + HöheAnpassungswert
End If
Next n1
' passt die Spaltenbreite an
' Columns(Startspalte + 2).ColumnWidth = SpaltenbreiteMax
' Columns(Startspalte + 7).ColumnWidth = SpaltenbreiteMax

Set Bereich = Range("Druck_Seite6")
Bereich.Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.CenterFooter = ""
.Orientation = xlPortrait
End With
Application.GoTo Reference:="Druck_Seite6"
Selection.PrintPreview
' Selection.PrintOut
' ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
' Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub