Druckbereich per VBA

[knallebumm]

HAllo,
ich habe hier in dem Forum den Code von Attila gefunden und ihn auf meine Tabelle angepasst.
aber es passiert nichts.

Vielleicht kann mir ja geholfen werden.
Hier der Originalcode

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

Und hier der von mir geänderte
Die Zellen Angepasst und den letzten Teil entfernt.

Code:

Sub test()
  Dim i As Long, j As Long
  Dim arr1, arr2
 
  arr1 = Array("$C167", "C111", "C57", "C7")
  arr2 = Array("$B$2:$Z$204", "B2:Z166", "B2:Z110", "B2:Z56")
  For i = LBound(arr1) To UBound(arr1)
     If Range(arr1(i)) <> "" Then
        ActiveSheet.PageSetup.PrintArea = arr2(i)
        ActiveWindow.SelectedSheets.PrintPreview
        Exit For
     End If
     Next i
End Sub

Hiermit arbeite ich zur Zeit
Möchte aber immer ganze Seiten gedruckt haben

Code:

Sub Druck()

Dim zm As Long

With ActiveSheet

zm = .Columns("C").Find(What:="*", SearchDirection:=xlPrevious).Row

.Range("B2:Z" & zm).Select
.PageSetup.PrintArea = Selection.Address
ActiveWindow.SelectedSheets.PrintPreview


End With
End Sub

Gruß
Thomas

[Steffl]

Hallo Thomas,

so ganz habe ich es nicht verstanden

Code:

Sub Druck()

   Dim zm As Range
   Dim lngC As Long
  
   For lngC = 1 To ThisWorkbook.Worksheets.Count
      With Worksheets(lngC)
         Set zm = .Columns("C").Find(What:="*", SearchDirection:=xlPrevious)
         If Not zm Is Nothing Then
            '.Range("B2:Z" & zm).Select
            .PageSetup.PrintArea = .Range("B2:Z" & zm.Row).Address
            'ActiveWindow.SelectedSheets.PrintPreview
         End If
      End With
   Next lngC
End Sub

[knallebumm]

Hallo Stefan,

wenn in Zelle C7 was eingetragen ist, soll der Druckbereich B2:Z56 sein
wenn in Zelle C57 was eingetragen ist , soll der Druckbereich B2:Z110 sein
wenn in Zelle C111 was eingetragen ist , soll der Druckbereich B2:Z166 sein
wenn in Zelle C167 was eingetragen ist , soll der Druckbereich B2:Z204 sein.

Der Code den ich bislang verwende macht mir den Druckbereich nur bis zu letzten beschriebenen Zelle in C, ich würde aber gerne immer ganze gedruckte Seiten haben, aber auch nicht alle vier Blätter wenn z.B.nur bis Zeile 15 ausgefüllt ist

Nachdem ich mir meinen Ursprungsbeitrag nochmal durchgelesen habe, stelle ich auch fest, dass eine Erklärung fehlt

Gruß
Thomas

[Käpt'n Blaubär]

Hallo Thomas,


Nachdem ich mir meinen Ursprungsbeitrag nochmal durchgelesen habe, stelle ich auch fest, dass eine Erklärung fehlt
Gruß
Thomas


.... und was hältst Du vom zur Verfügung stellen einer (Beispiel-)Datei, damit man auch was Reales zum Testen hat?

[knallebumm]

  Holzliste Forumtest.xlsm (Größe: 67,43 KB / Downloads: 5)

Na klar ein Bild sagt mehr als Worte

Gruß
Thomas

[Käpt'n Blaubär]

Na klar ein Bild sagt mehr als Worte

Gruß
Thomas

Hallo Thomas,

leider bin ich im Krankenhaus und habe hier auf dem Laptop nur Excel 2003.
Kann also mit der Datei zur Zeit nicht wirklich was anfangen.
Aber es gibt im Forum ja jede Menge Helfer, die diese Beschränkung nicht haben.

[knallebumm]

  Holzliste Forumtest.xls (Größe: 132,5 KB / Downloads: 3)
Erst mal gute Besserung.
Wenn du Langeweile hast, hier ist die Datei in 2003

Gruß
Thomas

[Käpt'n Blaubär]

Hallo Thomas,

danke für die Datei.

[Steffl]

Hallo Thomas,

teste mal

Code:

Sub Druck()
   Dim lngC As Long
   Dim vntZelle As Variant, vntBereich As Variant
  
   vntZelle = Array("C167", "C111", "C57", "C7")
   vntBereich = Array("204", "166", "110", "56")
   With ActiveSheet
      For lngC = 0 To UBound(vntZelle)
         If .Range(vntZelle(lngC)) <> "" Then .PageSetup.PrintArea = .Range("B2:Z" & CStr(vntBereich(lngC))).Address: Exit For
      Next lngC
   End With
End Sub

[knallebumm]

Hallo Stefan,
da passiert leider nichts.

Gruß
Thomas