nach Druckauftrag Meldung anzeigen

Sub druckGrau(control As IRibbonControl)
'* 31.12.07,07.05.08 *
'* erstellt von Karin, http://beverly.excelhost.de*
'* beverly@excelhost.de *
Dim arrWerte()                          ' Variable für Array
Dim raZelle As Range                    ' Variable für die Zelle als Range
Dim loZaehler As Long                   ' Schleifenzähler
Dim loZaehler2 As Long                  ' Schleifenzähler
Dim rngDruckbereich As Range            ' Druckbereich
'Dim wk As Workbook
ActiveSheet.PageSetup.PrintArea = "$B$1:$O$50"
'Druckbereich festlegen
Set rngDruckbereich = Range("B1,O50")
'   Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'   Blattschutz aufheben
ActiveSheet.Unprotect Password:=""
'   Ausführung in Tabelle1
With ActiveSheet
'       Schleife über jede Zelle des benutzten Bereichs
For Each raZelle In ActiveSheet.UsedRange
'           Zelle ist mit einer Füllfarbe  Weiß oder Schriftfarbe Rot formatiert
If raZelle.Interior.ColorIndex  2 Or raZelle.Font.Color = 255 Then
'               Array dynamisch erweitern
ReDim Preserve arrWerte(0 To 3, 0 To loZaehler)
'               Einlesen der Zelladresse in das Array
arrWerte(0, loZaehler) = raZelle.Address
'               Einlesen der Füllfarbe in das der Zelle in das Array
arrWerte(1, loZaehler) = raZelle.Interior.Color
arrWerte(2, loZaehler) = raZelle.Font.Color
arrWerte(3, loZaehler) = raZelle.Font.Bold
'               Füllfarbe der Zelle auf Weiß setzen
raZelle.Interior.ColorIndex = 2
'               Schriftschnitt auf nicht Fett setzen
raZelle.Font.Bold = False
'               Schriftfarbe auf Schwarz setzen
raZelle.Font.ColorIndex = 1
'               Schleifenzähler um 1 erhöhen
loZaehler = loZaehler + 1
End If
Next raZelle
'       Tabelle drucken
'        .PrintOut
'       Seitenvorschau öffnen
.PrintPreview
'       Drucker Auswahl Dialog öffnen
'         .Application.Dialogs(xlDialogPrint).Show
'       Schleife über alle Elemente des Arrays
For loZaehler2 = 0 To loZaehler - 1
'           Zurückübertragen der ausgelesenen Füllfarben
.Range(arrWerte(0, loZaehler2)).Interior.Color = arrWerte(1, loZaehler2)
.Range(arrWerte(0, loZaehler2)).Font.Color = arrWerte(2, loZaehler2)
.Range(arrWerte(0, loZaehler2)).Font.Bold = arrWerte(3, loZaehler2)
Next loZaehler2
End With
'   Blattschutz aktivieren
ActiveSheet.Protect Password:=""
'   Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

msgBox("Unterschrift nicht vergessen", vbOnlyOK, "Nachfrage")