VBA Druckbereiche

Hallo Leute,

habe vor kurzer Zeit eine Inventurliste programmiert. diese kann blätter einfügen, löschen, …
Nun will ich eine Druckprozedur dazu programmieren, komme aber nicht mehr weiter. kA, was das Problem ist.

Zu meinem Problem:
ich habe auf dem Übersichtsblatt zwei Steuerelemente (buttons).

  1. für Übersichtsblatt drucken

  2. für alle anderen Blätter drucken

  3. Sub Uebersichtdrucken()
    Dim countsheet As Integer
    Dim i As Integer
    Dim pwd As String
    Dim l As Integer

pwd = „basti06“
Sheets(„Übersicht“).Unprotect pwd

Sheets(„Übersicht“).Activate
Range(„A2:smiley:6,A7:A38,B9:smiley:38,D7:smiley:8,C7:C8“).Select
Selection.Interior.ColorIndex = xlNone
ActiveSheet.PageSetup.PrintArea = Range(„A2:smiley:38“).Address

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range(„A2:smiley:6,A7:A38,B9:smiley:38,D7:smiley:8,C7:C8“).Select
Selection.Interior.ColorIndex = 36

Sheets(„Übersicht“).Protect pwd

End Sub

Diese Sub funktioniert auch und habe kein Problem. Es druck genau den Bereich, denn ich will.

  1. Sub Blaetterdrucken()
    Dim countsheets As Integer
    Dim i As Integer
    Dim pwd As String

pwd = „basti06“

For i = 1 To Sheets.Count - 2
Worksheets(i).Unprotect pwd
Next i

countsheets = Sheets.Count - 2

For i = 1 To countsheets
Sheets(i).Select
Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Range(„D56“).Activate
Selection.Interior.ColorIndex = 36
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = „$A$1:blush:G$58“
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.PrintTitleRows = „“
.PrintTitleColumns = „“
End With
ActiveSheet.PageSetup.PrintArea = „$A$1:blush:G$58“
With ActiveSheet.PageSetup
.LeftHeader = „“
.CenterHeader = „“
.RightHeader = „“
.LeftFooter = „“
.CenterFooter = „“
.RightFooter = „“
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 97
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i

End Sub

Bei dieser Sub funktioniert der Druckvorgang nicht bzw. das Übersichtsblatt wird gedruckt, jedoch 2 mal, dann wechselt er auf das Blatt 1 und druckt es auch, aber nicht mit richtigen Druckbereich.

Könnte mir hier jemand weiterhelfen. Finde leider keine Lösung.
Über jede Antwort, bin ich sehr dankbar.

Gruß,
Sebastian

Hallo Sebastian
Gib uns bitte noch ein paar Infos:

habe vor kurzer Zeit eine Inventurliste programmiert. diese
kann blätter einfügen, löschen, …

Hat es ausschliesslich Tabellenblätter oder auch Diagramme etc?
Wird das jeweils neue Blatt am Ende eingefügt?

ich habe auf dem Übersichtsblatt zwei Steuerelemente buttons).

  1. für Übersichtsblatt drucken

= erstes Blatt?

  1. für alle anderen Blätter drucken

= Blatt 2 bis Ende

  1. Sub Blaetterdrucken()
    For i = 1 To Sheets.Count - 2

Also ab Blatt eins (=Uebersicht) bis und mit dem drittletzten?
Was sind die letzten 2 Blätter? Ist die Uebersicht etwa am Schluss?
Beschreibe bitte, wie die Blätter angeordnet sind.
Bis dann
Erich

PS Dein Code „riecht“ sehr nach Makroaufzeichnung und könnte viel eleganter geschrieben werden. Da es sich jedoch um einen Druckvorgang handelt, ist keine rasche Berechnung nötig; muss sowieso auf den Drucker warten.

Hallo Sebastian
Hat es ausschliesslich Tabellenblätter oder auch Diagramme
etc?

Nur Tabellenblätter

Wird das jeweils neue Blatt am Ende eingefügt?

an einer Position vor dem versteckten Tabellenblatt Vorlage (2letzter Stelle). Aus dem Tabellenblatt Vorlage nimmt er denn inhalt und kopiert das Selektierte in das neu erstellte Tabellenblatt.

For i = 1 To Sheets.Count - 2

Also ab Blatt eins (=Uebersicht) bis und mit dem drittletzten?
Was sind die letzten 2 Blätter? Ist die Uebersicht etwa am
Schluss?

K, diese For-Schleife ist falsch, i = Index, also ab 2tem Tabellenblatt bis zum Sheets.Count - 1 . Bsp: For i = 2 to Sheets.Count - 1 , Oder sehe ich das Falsch? Dies Schleife löst schon mal ein Teil meines Problems.

PS Dein Code „riecht“ sehr nach Makroaufzeichnung und könnte
viel eleganter geschrieben werden. Da es sich jedoch um einen
Druckvorgang handelt, ist keine rasche Berechnung nötig; muss
sowieso auf den Drucker warten.

Ja das stimmt, hatte diese Prozedur programmiert und wollte nicht, dann habe ich ein Makro aufgezeichnet und es hat wiederrum nicht funktioniert.

Werde dir morgen bescheid geben, ob es funktioniert hat.

Gruß,
Sebastian

Hallo Erich,

habe jetzt die For-Schleife verändert und es hat funktioniert. Der Startpunkt des Druckprozesses hat nun an der richtigen Stelle begonnen und druckt jetzt auch das, was ich drucken will.

Danke für deine Antwort.

Gruß und schönen Morgen,
Sebastian

--------CODE---------

Sub Blaetterdrucken()
Dim countsheets As Integer
Dim i As Integer
Dim j As Integer
Dim pwd As String

pwd = „basti06“

For j = 2 To Sheets.Count - 1
Worksheets(j).Unprotect pwd
Next j

countsheets = Sheets.Count - 1

For i = 2 To countsheets
Sheets(i).Select
Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Selection.Interior.ColorIndex = xlNone
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = Range(„A1:G58“).Address
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.PrintTitleRows = „“
.PrintTitleColumns = „“
End With
ActiveSheet.PageSetup.PrintArea = Range(„A1:G58“).Address
With ActiveSheet.PageSetup
.LeftHeader = „“
.CenterHeader = „“
.RightHeader = „“
.LeftFooter = „“
.CenterFooter = „“
.RightFooter = „“
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 97
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Selection.Interior.ColorIndex = 36
Next i

For j = 2 To Sheets.Count - 1
Worksheets(j).Protect pwd
Next j

Worksheets(„Übersicht“).Select

End Sub

Hallo Sebastian

habe jetzt die For-Schleife verändert und es hat funktioniert.
Der Startpunkt des Druckprozesses hat nun an der richtigen
Stelle begonnen und druckt jetzt auch das, was ich drucken
will.

Gut so!

Ich kann es dennoch nicht verkneifen, auf den Code zurückzukommen,da er wesentlich eleganter geschrieben werden könnte. Beim Aufzeichnen eines Makros wird jeder Mausklick mit „select“ bewertet. Meist ist es aber gar nicht nötig, zu selektieren, da VBA sehr gut auf nicht selektierte Bereiche zugreift, z.B. anstatt zweimal select

Sheets(i).Select
Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Selection.Interior.ColorIndex = xlNone

machst du es ohne select:

 Sheets(i).Range("A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58").I .Interior.ColorIndex = xlNone

Dies nur als Anregung für grössere Makros, die dann wesentlich schneller laufen.
Beste Grüsse
Erich

Ich kann es dennoch nicht verkneifen, auf den Code
zurückzukommen,da er wesentlich eleganter geschrieben werden
könnte. Beim Aufzeichnen eines Makros wird jeder Mausklick mit
„select“ bewertet. Meist ist es aber gar nicht nötig, zu
selektieren, da VBA sehr gut auf nicht selektierte Bereiche
zugreift, z.B. anstatt zweimal select

Sheets(i).Select
Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Selection.Interior.ColorIndex = xlNone

machst du es ohne select:
Sheets(i).Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).I
.Interior.ColorIndex = xlNone
Dies nur als Anregung für grössere Makros, die dann wesentlich
schneller laufen.
Beste Grüsse
Erich

Hallo Erich,

stimmt, habe das aufgezeichnete Makro auf meine Bedürfnisse angepasst.

Weiss auch dass die Makro-Aufzeichnung echt jeden einzelnen Schritt aufzeichnet, dh. wenn ich zB. an dem Scroll-Rad drehe, wird das mitgeschnitten. Viel Code für wenig Funktion. :smile:

Wünsch dir noch einen schönen Tag.
Gruß,
Sebastian