Makro wird nicht richtig ausgeführt!
09.02.2009 16:37:09
markus473
das folgende Makro soll nach vorheriger Paßwortabfrage den Druckbereich bei allen selektierten Blättern festlegen.
Das Problem ist, der Druckbereich wird nur für das zuerst markierte Blatt festgelegt.
Wer kann mir sagen woran es liegen könnte!
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("Admin", , xlValues, xlWhole, xlByColumns, xlNext)
If rg Is Nothing Then
MsgBox "Der User 'Admin' wurde nicht gefunden!", 16, "Fehler!"
Else
Inp = InputBox("Druckbereich festlegen" _
& Chr(13) & Chr(13) & "Geben Sie das Kennwort 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:H109"
.HPageBreaks.Add before:=Range("B48")
.HPageBreaks.Add before:=Range("B89")
.HPageBreaks.Add before:=Range("B99")
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
End With
Next lngI
End If
End If
Set rg = Nothing
Set ws = Nothing
ActiveSheet.PrintPreview 'Druckansicht
End Sub