ActiveSheet.PageSetup.FitToPages
07.06.2007 16:19:46
Klaus
Ich habe mit folgenden Code gebastelt, um eine Exeltabelle ohne Formeln und Verknüpfungen in ausdruckbare bzw. verschickbare Form zu bringen.
Dazu blende ich zunächst alle unrelevanten Teile aus und kopiere die noch sichtbaren in eine neue Tabelle.
Soweit klappt das auch. Probleme:
- Der Ausdruck soll immer auf einer Seite erfolgen. Der Makrorekorder hat mir "PageSetup.FitToPages" rausgeworfen, aber das will im Makro nicht mehr funktionieren.
- Der Druckbereich steigt mit 1004 aus: "Die PrintArea-Eigenschaft des PageSetup-Objektes kann nicht festgelegt werden.
Wenn mir jemand die entsprechenden Codezeilen anpassen könnte, das währ ganz toll!
Hier ist der gesamte Code:
Sub PG_Druck()
Application.ScreenUpdating = False
Dim r As Range
Dim lColI As Integer
Dim lRowI As Integer
Dim PrintThis As String
With Sheets("PG-Plan")
For Each r In .Range("M1:AV1")
If r.Value = 0 Then r.EntireColumn.Hidden = True
Next 'r
.Range("C3:AV158").SpecialCells(xlCellTypeVisible).Copy
.Range("M1:AV1").EntireColumn.Hidden = False
End With
Workbooks.Add
'Focus auf neuem Workbook
Range("A1").PasteSpecial 'Inhalte mit Formaten kopieren
Range("A1").PasteSpecial Paste:=xlValues 'Inhalte als Text in bestehende Formate kopieren
Application.CutCopyMode = False 'Ameisen
Columns("A:A").ColumnWidth = 13
Columns("B:IV").ColumnWidth = 7
lColI = Range("IV5").End(xlToLeft).Column
lRowI = Range("A65535").End(xlUp).Row
PrintThis = "A1:" & Chr(64 + lColI) & lRowI
With ActiveSheet.PageSetup
'.PrintArea = Range(PrintThis) !!!! funktioniert nicht
.PrintGridlines = True
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
'.FitToPagesWide = 1 !!!! funktioniert nicht
'.FitToPagesTall = 1 !!!! funktioniert nicht
End With
Application.ScreenUpdating = True
End Sub
Vielen Dank im vorraus, Forum!
Grüße,
Klaus M.vdT.