Makro Druckbereich festlegen

Forumthread: Makro Druckbereich festlegen

04.03.2008 09:13:00

markus473

Guten Morgen zusammen,
habe folgendes Makro, in dem bei allen selektierten Blättern nach vorheriger Passwortabfrage der Druckbereich festgelegt wird.
Nach ausführen des Makros, ist jedoch nur der Druckbereich des ersten Blattes festgelegt.
Kann mir jemand sagen woran es liegt?
Danke und Gruß Markus


Sub DruckbereichFestlegen()
Dim Inp As String, ws As Worksheet, rg As Range
Set ws = ThisWorkbook.Worksheets("Master")
Set rg = ws.Range("A1:A100").Find("Administrator", , xlValues, xlWhole, xlByColumns,  _
xlNext)
If rg Is Nothing Then
MsgBox "Der User 'Administrator' wurde nicht gefunden!", 16, "Fehler!"
Else
Inp = InputBox("Geben Sie das Passwort vom Administrator ein!")
If Crypto(Inp, cKey)  rg.Offset(0, 1).Value Then
MsgBox "Das Passswort ist falsch!", 16, "Fehler!"
Exit Sub
Else
Dim lngI As Long
For lngI = 1 To ActiveWindow.SelectedSheets.Count
With ActiveWindow.SelectedSheets(lngI)
.PageSetup.PrintArea = "B1:H533"
.HPageBreaks.Add before:=Range("B48")
.HPageBreaks.Add before:=Range("B89")
.HPageBreaks.Add before:=Range("B132")
.HPageBreaks.Add before:=Range("B174")
.HPageBreaks.Add before:=Range("B217")
.HPageBreaks.Add before:=Range("B259")
.HPageBreaks.Add before:=Range("B302")
.HPageBreaks.Add before:=Range("B345")
.HPageBreaks.Add before:=Range("B387")
.HPageBreaks.Add before:=Range("B430")
.HPageBreaks.Add before:=Range("B472")
.HPageBreaks.Add before:=Range("B515")
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
Range("D8").Select
End With
Next lngI
End If
End If
Set rg = Nothing
Set ws = Nothing
ActiveSheet.PrintPreview 'Druckansicht
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro Druckbereich festlegen

04.03.2008 10:47:57

Hans
AW: Makro Druckbereich festlegen

04.03.2008 11:33:13

markus473

AW: Makro Druckbereich festlegen

04.03.2008 10:47:57

Hans

Hallo Markus,
du sprichts mit deinem Code nur den Aktiven Tabellenblatt an indem du den Befehl Activesheet mehrmals ansprichst. Wenn alle Tabellenblätter gleich eingestellt werden müssen da kannst deinen Code zerteilen und einen unterprogramm einbauen die könnte so aussehen.


Sub DruckbereichFestlegen_1()
Dim Inp As String, ws As Worksheet, rg As Range
Set ws = ThisWorkbook.Worksheets("Master")
Set rg = ws.Range("A1:A100").Find("Administrator", , xlValues, xlWhole, xlByColumns,  _
xlNext)
If rg Is Nothing Then
MsgBox "Der User 'Administrator' wurde nicht gefunden!", 16, "Fehler!"
Else
Inp = InputBox("Geben Sie das Passwort vom Administrator ein!")
If Crypto(Inp, cKey)  rg.Offset(0, 1).Value Then
MsgBox "Das Passswort ist falsch!", 16, "Fehler!"
Exit Sub
Else
call  DruckbereichFestlegen_2
End If
End If
Set rg = Nothing
Set ws = Nothing
end 

Sub


Sub DruckbereichFestlegen_2
call DruckbereichFestlegen_3
Sheets("Tabelle2").Select
call DruckbereichFestlegen_3
Sheets("Tabelle3").Select
call DruckbereichFestlegen_3
End Sub




Sub DruckbereichFestlegen_3()
Dim lngI As Long
For lngI = 1 To ActiveWindow.SelectedSheets.Count
With ActiveWindow.SelectedSheets(lngI)
.PageSetup.PrintArea = "B1:H533"
.HPageBreaks.Add before:=Range("B48")
.HPageBreaks.Add before:=Range("B89")
.HPageBreaks.Add before:=Range("B132")
.HPageBreaks.Add before:=Range("B174")
.HPageBreaks.Add before:=Range("B217")
.HPageBreaks.Add before:=Range("B259")
.HPageBreaks.Add before:=Range("B302")
.HPageBreaks.Add before:=Range("B345")
.HPageBreaks.Add before:=Range("B387")
.HPageBreaks.Add before:=Range("B430")
.HPageBreaks.Add before:=Range("B472")
.HPageBreaks.Add before:=Range("B515")
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
Range("D8").Select
End With
Next lngI
ActiveSheet.PrintPreview 'Druckansicht
End Sub


MfG

Hans B.

AW: Makro Druckbereich festlegen

04.03.2008 11:33:13

markus473

Danke für den Tip,
das ist leider schwierig, da ich die Blätter erstellen lasse und das bis zu 70 sein können (ist variabel), wollte ich halt für alle selektierten den Druckbereich festlegen lassen.
Alle selektierten auch aus dem Grund, da auch Blätter schon andere festgelegte Druckbereiche haben.
Beim Druckmakro funktioniert es ja auch!
Gibt es da keine Lösung?
Danke und Gruß Markus


Sub BlaetterDrucken()
'Dim Inp As String, ws As Worksheet, rg As Range
'Set ws = ThisWorkbook.Worksheets("Master")
'Set rg = ws.Range("A1:A100").Find("Administrator", , xlValues, xlWhole, xlByColumns,  _
xlNext)
'If rg Is Nothing Then
'MsgBox "Der User 'Administrator' wurde nicht gefunden!", 16, "Fehler!"
'Else
'Inp = InputBox("Geben Sie das Passwort vom Administrator ein!")
'If Crypto(Inp, cKey)  rg.Offset(0, 1).Value Then
'MsgBox "Das Passswort ist falsch!", 16, "Fehler!"
'Exit Sub
'End If
Dim wks As Object, Pagenumber As Integer
Pagenumber = Val(InputBox("Welche Seite soll gedruckt werden ?                          (z.B.:  _
1 für Januar, 2 für Februar usw.)", _
"Seite in selektierten Blättern drucken", 1))
If Pagenumber = 0 Then Exit Sub
For Each wks In ActiveWindow.SelectedSheets
wks.PrintOut From:=Pagenumber, To:=Pagenumber, Copies:=1, _
Preview:=False, Collate:=True
Next
'End If
'Set rg = Nothing
'Set ws = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro Druckbereich festlegen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread