Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Druckbereich per VBA
#1
Hallo zusammen,

komme irgendwie nicht weiter mit einem Makro.

Und zwar:
Wenn Zelle F40 mehr als "", dann drucke den Druckbereich von B1:Z41
Wenn Zelle F40 und F80 mehr als "", dann drucke den Druckbereich von B1:Z81
Wenn Zelle F40, F80, F120 mehr als "", dann drucke den Druckbereich von B1:Z121
Wenn Zelle F40, F80, F120 und F160 mehr als "", dann drucke den Druckbereich von B1:Z1611

Ich hoffe, dass ich mich klar ausgedrückt habe und bedanke mich schon mal im Voraus!!!

Geändert: Hatte vergessen zu erwähnen, dass in allen F-Zellen Formeln hinterlegt sind!!!
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#2
Hallo Bernie,

ich würde es so versuchen
Code:
Option Explicit

Sub Druckbereich()

   ActiveSheet.PageSetup.PrintArea = ""
  
   If ActiveSheet.Range("F40").Value <> "" And _
      ActiveSheet.Range("F80").Value <> "" And _
      ActiveSheet.Range("F120").Value <> "" And _
      ActiveSheet.Range("F160").Value <> "" Then
      ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$1611"
   ElseIf ActiveSheet.Range("F40").Value <> "" And _
      ActiveSheet.Range("F80").Value <> "" And _
      ActiveSheet.Range("F120").Value <> "" Then
      ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$121"
   ElseIf ActiveSheet.Range("F40").Value <> "" And _
      ActiveSheet.Range("F80").Value <> "" Then
      ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$81"
   ElseIf ActiveSheet.Range("F40").Value <> "" Then
      ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$41"
   End If
    
End Sub
Gruß Peter
[-] Folgende(r) 1 Nutzer sagt Danke an pefeu für diesen Beitrag:
  • Bernie
Antworten Top
#3
Hallo Bernie,

müssen alle Zellen auf nicht leer geprüft werden oder reicht es, wenn z.B F160 nicht leer dann den Bereich "$B$1:$Z$1611" drucken?

Damit würde der Code etwas kürzer ausfallen.
Gruß Atilla
Antworten Top
#4
Hallo Atilla,

schön mal wieder von Dir zu hören. War gerade am testen von Peters Vorschlag und hab noch Probleme mit dem Druckbereich.

Ja, du hast recht, wenn lediglich die einzelne F-Zelle, obwohl mit Formel hinterlegt, kein berechnenden Wert hat.

Es sollte auch der jeweilige Druckbereich Seite1= A2:Z41, Seite2=A2:Z81 usw. berücksichtigt werden. D.h. jeder Seite (4 gesamt) umfasst 40 Zeilen.
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#5
Hallo Peter,

Danke für deine schnelle Hilfe.

Hab dein Vorschlag auf Druckbereich angepasst und die ersten beiden Seiten sind optimal, die dritte Seite übernimmt von der vierten Seite die erste Zeile mit auf Seite drei.

Bin noch am tüfteln.
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#6
Hallo Bernie,

da Du im letzten Beitrag andere Bereiche nennst als im ersten, habe ich mal die Bereiche aus dem ersten Beitrag genommen. Das Prinzip solltest Du aber anhand des Codes erkennen und für Dich anpassen können.

Code:
Sub test()
   Dim i As Long, j As Long
   Dim arr1, arr2
  
   arr1 = Array("$F160", "F120", "F80", "F40")
   arr2 = Array("$B$1:$Z$1611", "B1:Z121", "B1:Z81", "B1:Z41")
   For i = LBound(arr1) To UBound(arr1)
      If Range(arr1(i)) <> "" Then
         ActiveSheet.PageSetup.PrintArea = arr2(i)
         Exit For
      End If
   Next i
  
   ActiveSheet.ResetAllPageBreaks
   For j = 41 To Range(arr2(i)).Rows.Count Step 41
      ActiveSheet.HPageBreaks.Add Cells(j, 1)
   Next j

End Sub
Gruß Atilla
Antworten Top
#7
Hallo Atilla,

die letzten Zelldaten waren die Richtigen.
Allerdings wird die Skalierung bzw. die Seitenumbrüche entfernt, so dass ich keine richtige Druckseite habe, verschiebt sich alles.

Also Bereich der Druckseite ist von A2:Z41 + jeweils 40 Zeile je Druckseite, Skalierung hatte ich auf 93% und hatte auch einen Seitenumbruch eingefügt.

Folgenden Code habe ich an deinen gehängt...
Code:
sDruckerAktuell = Application.ActivePrinter
   'Application.ActivePrinter = "PDFCreator auf Ne00:"
   'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ChDir "C:\Users\Bernd Kiehl\Downloads"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\Bernd Kiehl\Downloads\Dienstplan_Kiehl.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
   Application.ActivePrinter = sDruckerAktuell
End Sub

Da dein Code die von mir per Menü eingestellten Formatierungen für den Druck übern Haufen wirft.

Könntest du mir das ändern?
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top
#8
Hallo Bernie,

dann lösch mal diesen Teil:

Code:
ActiveSheet.ResetAllPageBreaks
   For j = 41 To Range(arr2(i)).Rows.Count Step 41
      ActiveSheet.HPageBreaks.Add Cells(j, 1)
   Next j
Gruß Atilla
Antworten Top
#9
Hallo Atilla,

ja, jetzt passte es! Danke dir recht♥lich Thumps_up
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste