Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1164to1168
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1164to1168
1164to1168
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro für Druckbereich

Makro für Druckbereich
Thomas
Hallo,
ich habe mir ein Makro zum Anpassen des Druckbereiches und einfügen eines Seitenumbruches aufgezeichnet. Leider bleibe ich bei der Ausführung auf den Rest meiner Tabellenblätter immer an der Stelle zum Setzen des Umbruches
(Set ActiveSheet.HPageBreaks(2).Location = Range("A37"))
hängen. Kann mir hier jemand bitte behilfleich sein. 
Sub DBereich()
' DBereich Makro
Dim Blatt As Object
For Each Blatt In ThisWorkbook.Worksheets
With Blatt.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&""Arial,Fett""Gleichfeld Gebäudereinigung" & Chr(10) & "& -service  _
GmbH"
.LeftFooter = "FB Stundennachweise, Stand 03.09.2007"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15748031496063)
.RightMargin = Application.InchesToPoints(0.15748031496063)
.TopMargin = Application.InchesToPoints(0.47244094488189)
.BottomMargin = Application.InchesToPoints(0.275590551181102)
.HeaderMargin = Application.InchesToPoints(0.15748031496063)
.FooterMargin = Application.InchesToPoints(0.15748031496063)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.SmallScroll Down:=15
ActiveSheet.ResetAllPageBreaks
Set ActiveSheet.HPageBreaks(2).Location = Range("A37")
ActiveSheet.PageSetup.PrintArea = "$A$1:$BP$57"
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 70
Next Blatt
End Sub

Vielen Dank, Tom
PS: Evtl. geht dies ja auch einfacher und vor allem schneller, auch hier wäre ich für Lösungstips sehr dankbar.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro für Druckbereich
05.07.2010 14:24:47
Björn
Hallo,
ich weiß nicht, wie Du das aufgezeichnet hast, aber versuch es mal so:
ActiveSheet.HPageBreaks.Add Before:=Range("A37")
Gruß
Björn B.
leicht vereinfacht
05.07.2010 14:38:10
Björn
Hallo Tom,
das ganze nochmal vereinfacht...
Dein Fehler war, dass Du am Anfang eine Schleife mit For Each Blatt machst. Danach setzt Du die Eigenschaften aber mit ActiveSheet. Das ist immer das gleiche, weil Du ja kein anderes aktivierst.
So müsste es klappen. Hab unten was auskommentiert, das kennt mein 2003 nicht.
Und noch was.
Excel zeichnet gerade bei Seiteneinrichtung allen möglichen Quatsch mit auf, der meist Standard ist.
Z.B. ".PrintGridlines = False", das ist Standardmäßig immer False. Hier kannst du Dir viel Zeit sparen, wenn Du Dir einmal die Mühe machst, wirklich nur das drin zu lassen, was auch wirklich neu gesetzt / verändert werden muss.
Je nachdem, wieviele Blätter Du hast, kann der Code schon seeeehr lange brauchen.
Oder .CenterFooter = "" Das setzt "keine Fusszeile Mitte". Wenn das schon eine ist, dann wird sie gelöscht, aber normalerweise ist da ja keine, also macht der Befehl keine Änderung und Du kannst ihn weglassen.

Sub DBereich()
' DBereich Makro
Dim Blatt As Object
For Each Blatt In ThisWorkbook.Worksheets
With Blatt.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&""Arial,Fett""Gleichfeld Gebäudereinigung" & Chr(10) & "& -service  _
GmbH"
.LeftFooter = "FB Stundennachweise, Stand 03.09.2007"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15748031496063)
.RightMargin = Application.InchesToPoints(0.15748031496063)
.TopMargin = Application.InchesToPoints(0.47244094488189)
.BottomMargin = Application.InchesToPoints(0.275590551181102)
.HeaderMargin = Application.InchesToPoints(0.15748031496063)
.FooterMargin = Application.InchesToPoints(0.15748031496063)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
'   .OddAndEvenPagesHeaderFooter = False
'        .DifferentFirstPageHeaderFooter = False
'        .ScaleWithDocHeaderFooter = True
'        .AlignMarginsHeaderFooter = False
'        .EvenPage.LeftHeader.Text = ""
'        .EvenPage.CenterHeader.Text = ""
'        .EvenPage.RightHeader.Text = ""
'        .EvenPage.LeftFooter.Text = ""
'        .EvenPage.CenterFooter.Text = ""
'        .EvenPage.RightFooter.Text = ""
'        .FirstPage.LeftHeader.Text = ""
'        .FirstPage.CenterHeader.Text = ""
'        .FirstPage.RightHeader.Text = ""
'        .FirstPage.LeftFooter.Text = ""
'        .FirstPage.CenterFooter.Text = ""
'        .FirstPage.RightFooter.Text = ""
End With
With Blatt
.ResetAllPageBreaks
.HPageBreaks.Add Before:=Range("A37")
.PageSetup.PrintArea = "$A$1:$BP$57"
End With
Next Blatt
End Sub
Gruß
Björn
Anzeige
AW: leicht vereinfacht
05.07.2010 15:47:14
Thomas
Hallo Björn,
VIELEN Dank für Deine Bemühungen.
Das einzige was noch nicht richtig funktioniert ist dieser Umbruch. Es sind jetzt zwar überall 2 Seiten als Druckbereich definiert, der Umbruch liegt jedoch über der 39Zeile als gestrichelte Linie.
Hast Du hier noch eine Idee?
Das mit den vielen Eintragungen bei einer Aufzeichnung war mir schon fast klar, hab mich nur nicht getraut hier was zu entfernen.
MfG, Tom
bei mir klappt es...
07.07.2010 09:10:17
Björn
Hallo,
das kann ich mir nicht erklären.
Im Code steht ja direkt Zelle A37 drin, bei mir wird da auch der Umbruch eingefügt...
Was passiert, wenn du die Range mal änderst? Also z.b. mal A39 eingibst? Landet der Umbruch dann auf 41?
Gruß
Björn B.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige