[EXCEL 2010/VBA] Vor dem Drucken / nach dem Drucken

R

Ruppi

Aktives Mitglied
Hallo Leute

In einem Excel-"Formular" (Excel 2010 unter Windows 7 - 64 bit) sind einige Zellen "Yellow" eingefärbt, worin der User schlussendlich etwas (Text oder Zahlen etc.) hineinschreiben kann. Andere Zellen wiederum sind "Golden" eingefärbt, welche der User mit einem Doppelklick schwarz färben kann. Soweit so gut.

Mittels Makro werden vor dem Ausdruck die Farben Yellow und Golden entfernt, diese sollen ja nur dem User anzeigen, in welche Felder er etwas einfüllen kann, sie haben auf dem Papier nichts verloren. Sobald das Formular ausgedruckt ist, sollten die "Yellow"- und "Golden"-Felder wieder entsprechend zurückgefärbt werden.

Das Makro sieht wie folgt aus (abgelegt unter "Diese Arbeitsmappe"):

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim lngColorIndexY As Long
Dim lngColorIndexG As Long
Dim lngPCI(1 To 2) As Long
Dim lngPat(1 To 2) As Long
ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True

If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub
Application.EnableEvents = False
Cancel = True
With Me.Styles("Yellow").Interior
lngColorIndexY = .ColorIndex
lngPCI(1) = .PatternColorIndex
lngPat(1) = .Pattern
.Pattern = xlNone
End With

With Me.Styles("Golden").Interior
lngColorIndexG = .ColorIndex
lngPCI(2) = .PatternColorIndex
lngPat(2) = .Pattern
.Pattern = xlNone
End With

ActiveWindow.SelectedSheets.PrintOut
With Me.Styles("Yellow").Interior
.ColorIndex = lngColorIndexY
.PatternColorIndex = lngPCI(1)
.Pattern = lngPat(1)
End With
With Me.Styles("Golden").Interior
.ColorIndex = lngColorIndexG
.PatternColorIndex = lngPCI(2)
.Pattern = lngPat(2)
End With

Application.EnableEvents = True

End Sub


Das Makro ergibt einen "Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler" beim ersten ".Pattern = xlNone".

Ich stehe völlig auf dem Schlauch... Kann mir jemand sagen, wie ich diesen Fehler beheben kann?

Und kann mir jemand ein gutes Buch empfehlen, welches VBA behandelt und womit man es lernen kann?

Vielen herzlichen Dank im Voraus!

Ruppi
 
Xpert

Xpert

Stammgast
Versuchs mal mit:

Code: 
(...)
With Me.Styles("Yellow").Interior
lngColorIndexY = .ColorIndex
lngPCI(1) = .PatternColorIndex
lngPat(1) = .Pattern
    With
          .Pattern = xlNone
    End With
End With

(...)

oder du schliesst mit End With vor .Pattern = xlNone und deklarierst das ganze Objekt nochmal

Code: 
With Me.Styles("Yellow").Interior
lngColorIndexY = .ColorIndex
lngPCI(1) = .PatternColorIndex
lngPat(1) = .Pattern
End With
Me.Styles("Yellow").Interior.Pattern = xlNone
 
Zuletzt bearbeitet:
R

Ruppi

Aktives Mitglied
Hat leider nicht geklappt

Hallo Xpert

Hat leider nicht geklappt:

Mit dem ersten Code gibt es einen „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ nach dem „ActiveWindow.SelectedSheets.PrintOut“ beim „.ColorIndex = lngColorIndexY“.

Mit dem zweiten Code gibt es einen „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ bei „Me.Styles("Yellow").Interior.Pattern = xlNone“.

Könnte man den Feldern "Yellow" und "Golden" nicht vor dem Drucken ein neues "Format" zuweisen - zum Beispiel "White"? Und dieses White-Format nachher wieder in Yellow und Golden zurückschreiben? Oder für "Yellow" das Format "White" und für "Golden" das Format "Whiter", falls es zwei Formate braucht?

Ist nur so eine Idee, habe keinen blassen Schimmer, ob das funktioniert und habe leider noch weniger Ahnung, wie man das machen könnte.... :confused:

Hast Du oder jemand anders eine Idee dazu? Würde mir sehr weiterhelfen...

Vielen herzlichen Dank im Voraus!

Ruppi
 
Xpert

Xpert

Stammgast
Ich frage mich grundsätzlich warum die überhaupt die Werte für Golden und Yellow ausliest. Schiesslich solltest du dies ja kennen, nicht?

Wenn ja, kannst du vor dem Drucken folgendes machen:

Code: 
    With ActiveWorkbook.Styles("Yellow")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlNone 'setzt Golden auf ohne Füllfarbe
    Selection.Style = "Golden"

    With ActiveWorkbook.Styles("Golden")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone 'setzt Golden auf ohne Füllfarbe
    Selection.Style = "Golden"

Nach dem Printout einfach wieder die Werte für Yellwo und Golden wieder setzen (yellow = 6; golden = 44)

Code: 
    With ActiveWorkbook.Styles("Yellow")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    With ActiveWorkbook.Styles("Yellow").Interior
        .ColorIndex = 6
        .PatternColorIndex = xlAutomatic
        .Pattern = xlSolid 'hier voll gefüllt
    End With
    Selection.Style = "Golden"


    With ActiveWorkbook.Styles("Golden")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    With ActiveWorkbook.Styles("Golden").Interior
        .ColorIndex = 44 
        .PatternColorIndex = xlAutomatic
        .Pattern = xlSolid 'hier voll gefüllt
    End With
    Selection.Style = "Golden"
End Sub

Noch einfacher ist natürlich einfach im PageSetup bei Drucken schwarz/weiss zu setzten. Fragt sich halt, ob andere Farben gedruck werden müssen? Falls gar keine Farben gedruckt sein müssen, kannst du dir das ganze Makro zeugs sparen und einfach über Seite einrichten Schwarz/Weiss ausdrucken setzen.

VBA Code für das s/w setzen:
Code: 
Sub SetBlackWhite()
    ActiveSheet.PageSetup.BlackAndWhite = True
End Sub
    
Sub SetColor()
   ActiveSheet.PageSetup.BlackAndWhite = False
End Sub

Edit = Code verkürzt
 
Zuletzt bearbeitet:
Ray

Ray

Stammgast
Hallo Ruppi

Zu deinem VBA kann (will) ich dir nichts sagen. Ich halte die Vorgehensweise für viel zu kompliziert. Aber ich habe dir zwei alternative Lösungsvorschläge:

1. Vorschlag: Beim Drucken des Fomulars lediglich Schwarzweissdruck aktivieren. Dieser kann mit "Seite einrichten…" erreicht werden. Dieses Vorgehen hat jedoch den Nachteil, dass gar keine Farben oder Schattierungen gedruckt werden.

2. Vorschlag: Einen Druckbereich formatieren, bei dem die Farbgebung die gewünschte Ausgabe ergibt. Im Druckbereich, der unter Umständen weitgehend identisch wie der Eingabebereich aussieht, werden die Werte aus dem Eingabebereich übernommen. Den Druckbereich kann man durch Ausblendung auch unsichtbar machen und mittels VBA nur vorübergehend einblenden und dann drucken. Das kann man natürlich dann auch recht einfach wieder dadurch rückgängig machen, dass man den Druckbereich wieder ausblendet und dafür den Eingabebereich wieder einblendet. Ich löse dies üblicherweise mit einem nicht druckbaren Makro-Button auf dem Formular. Dieses Vorgehen hat den weiteren Vorteil, dass man den Eingabebereich unter Umständen wesentlich schlanker (nur wesentliche Felder) gestalten kann als den Output.

Na, wäre das etwas für dich?

Gruss
Ray
 
Masche

Masche

Stammgast
Ruppi schrieb:
Hast Du oder jemand anders eine Idee dazu? Würde mir sehr weiterhelfen...
Zum Vergrößern anklicken....
Ob es Dir weiter hilft, weiss ich nicht. Ich habe aber eine andere Idee, die ganz ohne Makros auskommt und die Dir vielleicht weiter hilft. Wir machen es nämlich in analogen Fällen wie folgt:

Felder, welche die User ausfüllen müssen, werden mit bedingter Formatierung gelb hinterlegt. Sobald der User etwas hinein schreibt, wird das betreffende Feld weiss. Zusätzlich erhalten solche Felder einen Kommentar, was im Feld erwartet wird. Solche Kommentare werden beim Ausdruck standardmässig nicht ausgedruckt.

Vielleicht wäre dies auch etwas für Dich?
 
R

Ruppi

Aktives Mitglied
Ohne Erfolg

Hallo zusammen

Vielen herzlichen Dank für Eure Hilfe!

@ Xpert: Leider bekomme ich noch immer einen „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ bei "ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone 'setzt Golden auf ohne Füllfarbe".

@ Ray: Den Versuch mit dem Schwarz-Weiss-Ausdruck habe ich gemacht. Dabei werden aber leider die schwarzen Vierecke ebenfalls auf weiss gesetzt bzw. nicht ausgedruckt.
Die Variante mit dem Druckbereich verstehe ich leider nicht.

@ Masche: Ouuuu, wie hätte mir diese Lösung gefallen! Allerdings habe ich da das Problem, dass nicht unbedingt alle gelben Felder etwas enthalten müssen. Beim Ausdrucken sollten dann aber trotzdem alle diese Felder nicht mehr mit gelb hinterlegt sein.

Insofern stehe ich also immer noch am Anfang :confused:

Könnte man den Feldern "Yellow" und "Golden" nicht vor dem Drucken ein neues "Format" zuweisen - zum Beispiel "White"? Und dieses "White"-Format nachher wieder in "Yellow" und "Golden" zurückschreiben? Oder für "Yellow" das Format "White" und für "Golden" das Format "Whiter", falls es zwei Formate braucht?

Zum besseren Verständnis habe ich vom Formular einen PrintScreen gemacht.

Ich hoffe sehr, irgend jeman kann mir helfen!!!

Herzlichen Dank im Voraus!!!!!

Ruppi
 

Anhänge

  • Formular.jpg
    Formular.jpg
    91,3 KB · Aufrufe: 10
Xpert

Xpert

Stammgast
Ruppi schrieb:
Hallo zusammen

Vielen herzlichen Dank für Eure Hilfe!

@ Xpert: Leider bekomme ich noch immer einen „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ bei "ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone 'setzt Golden auf ohne Füllfarbe".


Ruppi
Zum Vergrößern anklicken....


Du musst überprüfen, ob du den Style exakt so bennant hast, wie ich es habe ("Golden") bzw. ("Yellow") und sonst den Code entsprechend ändern.

Ich kann den Fehler nicht nachvollziehen, da bei mir der Code anstandslos läuft. Du müsstest nochmals dein ganzes Makro Posten damit ich es mir nochmals ansehen kann.
 
T

Thomas Ramel

Stammgast
Grüezi Ruppi

Ruppi schrieb:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim lngColorIndexY As Long
Dim lngColorIndexG As Long
Dim lngPCI(1 To 2) As Long
Dim lngPat(1 To 2) As Long

ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
Zum Vergrößern anklicken....

Warum schützt Du hier das Tabellenblatt (aber nur das eine, aktive)?

Kommetiere doch diese Zeile mal aus und teste dann nochmals.
 
R

Ruppi

Aktives Mitglied
Nahe am Erfolg...

Guten Morgen!!

Herzlichen Dank für Eure Hilfe!!

Ich habe den Code ganz genau so eingegeben (auch kopiert), wie Du ihn geschrieben hast, Xpert.

Wenn ich den Code genau so lasse, bekomme ich einen „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ bei „ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlNone 'setzt Yellow auf ohne Füllfarbe“.

Wenn ich die Zeile „ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True” lösche (wie es Thomas Ramel vorgeschlagen hat), bekomme ich bereits in der Zeile „.IncludeNumber = True“ nach „With ActiveWorkbook.Styles("Yellow")“ die Fehlermeldung „Laufzeitfehler ‚1004‘: Die IncludeNumber-Eigenschaft des Style-Objektes kann nicht festgelegt werden.“

Aber ich habe, glaube ich, das Problem ein bisschen weiter eingegrenzt: Wenn ich nämlich diesen Code alleine in einem Arbeitsblatt laufen lasse, funktioniert es auch bei mir:

Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim lngColorIndexY As Long
Dim lngColorIndexG As Long
Dim lngPCI(1 To 2) As Long
Dim lngPat(1 To 2) As Long
ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
 
  If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub
  Application.EnableEvents = False
  Cancel = True
 
    With ActiveWorkbook.Styles("Yellow")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlNone 'setzt Yellow auf ohne Füllfarbe
    Selection.Style = "Golden"
 
    With ActiveWorkbook.Styles("Golden")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone 'setzt Golden auf ohne Füllfarbe
    Selection.Style = "Golden"
 
 
   ActiveWindow.SelectedSheets.PrintOut
 
    With ActiveWorkbook.Styles("Yellow")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    With ActiveWorkbook.Styles("Yellow").Interior
        .ColorIndex = 36
        .PatternColorIndex = xlAutomatic
        .Pattern = xlSolid 'hier voll gefüllt
    End With
    Selection.Style = "Golden"
 
    With ActiveWorkbook.Styles("Golden")
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    End With
    With ActiveWorkbook.Styles("Golden").Interior
        .ColorIndex = 6
        .PatternColorIndex = xlAutomatic
        .Pattern = xlSolid 'hier voll gefüllt
    End With
    Selection.Style = "Golden"
End Sub


Allerdings habe ich unter "Tabelle1" noch folgenden Code, welcher für das Schwarzfärben bzw. wieder zurück Färben in Golden verantwortlich ist:

Code: 
Private Sub Worksheet_BeforeDoubleClick( _
        ByVal Target As Range, Cancel As Boolean)
 
    ActiveSheet.Unprotect Password:="Roger"
' 1 = schwarz   /   2 = weiss   /   36 = hellgelb   /   6 = gelb
    If Target.Interior.ColorIndex = 36 Then
    Target.Interior.ColorIndex = 36
    Selection.Style = "Yellow"
 
    ElseIf Target.Interior.ColorIndex = 6 Then
    Target.Interior.ColorIndex = 1
 
    ElseIf Target.Interior.ColorIndex = 1 Then
    Target.Interior.ColorIndex = 6
    Selection.Style = "Golden"
 
    End If
    Cancel = True
    ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Und irgendetwas an DIESEM Code verursacht die Fehlermeldungen.... :confused:

Aber was ???????????????

Danke! Danke! Danke! Danke! Danke!

Ruppi
 
Nebuk

Nebuk

PCtipp-Moderation
Teammitglied
Hallo Ruppi

Hast du schon den Debugger versucht? Wenn nicht, geh doch mal in den VBA Editor und such den entsprechenden Code/Tabelle aus. Danach einfach mit "F8" Zeile für Zeile durchgehen und falls der Fehler auftaucht, einfach die Zeile notieren.

Gruss
Nebuk
 
Xpert

Xpert

Stammgast
Xpert schrieb:
Du musst überprüfen, ob du den Style exakt so bennant hast, wie ich es habe ("Golden") bzw. ("Yellow") und sonst den Code entsprechend ändern.

Ich kann den Fehler nicht nachvollziehen, da bei mir der Code anstandslos läuft. Du müsstest nochmals dein ganzes Makro Posten damit ich es mir nochmals ansehen kann.
Zum Vergrößern anklicken....

Hast du das schon überprüft? Bei mir laufen beide Codes in einem Sheet einwandfrei.
 
T

Thomas Ramel

Stammgast
Grüezi Ruppi

Also ich glaube ja, dass Du da viel zu viel unnötigen Code drin hast.....

Die folgenden Zeilen tun hier bei das was Du im ersten Beitrag gewünscht hast:


Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub

    Application.EnableEvents = False
    Cancel = True

    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlNone    'setzt Yellow auf ohne Füllfarbe
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone    'setzt Golden auf ohne Füllfarbe

    ActiveWindow.SelectedSheets.PrintOut

    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlSolid    'hier voll gefüllt
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlSolid    'hier voll gefüllt

    Application.EnableEvents = True

End Sub


Des weiteren schaltest Du zu Beginn die Events aus, am Ende aber nicht wieder ein....
 
R

Ruppi

Aktives Mitglied
Immer noch nix...

Hallo Leute

Erstmal vielen Dank für die viele Zeit, die Ihr Euch nehmt, um mir zu helfen. Ich bin Euch allen wirklich unendlich dankbar!!


Weil es bei mir partout nicht funktionieren will und ich mich wohl schon zu lange mit dem Problem herumschlage, als dass ich noch eine Lösung finden (sehen) könnte, habe ich mal eine komplett neue Arbeitsmappe erstellt und jeden Schritt aufgeschrieben, den ich gemacht habe:
  1. Neue Arbeitsmappe angelegt
  2. Text reingeschrieben
  3. Auf Zellen B1 bis E1 (miteinander verbunden) die Formatvorlage „Gelb“ erstellt und wie folgt formatiert
    - Registerkarte Zahlen = Standard
    - Registerkarte Ausrichtung = nichts spezielles
    - Registerkarte Schrift = nichts spezielles
    - Registerkarte Rahmen = kein Rahmen
    - Registerkarte Ausfüllen = Farbe Rot 255 / Grün 255 / Blau 153
    - Registerkarte Schutz = Haken bei Gesperrt
  4. Mit „Format übertragen auf die Zellbereiche B2:E2 (miteinander verbunden) und B3:E3 (miteinander verbunden) übertragen
  5. Auf dem Zellbereich B1:E1 eine bedingte Formatierung erstellt. „Formel zur Ermittlung der zu formatierenden Zelle verwenden“ mit der Formel: =WENN(B1="";WAHR;FALSCH) und den Formatierungen
    - Registerkarte Zahlen = nichts spezielles
    - Registerkarte Schrift = nichts spezielles
    - Registerkarte Rahmen = Rahmenlinie unten
    - Registerkarte Ausfüllen = Keine Farbe
  6. Die gleiche bedingte Formatierung auf die Zellbereiche B2:E2 und B3:E3 mit dem Pinsel übertragen
  7. Auf Zelle A5 die Formatvorlage „Goldig“ erstellt und wie folgt formatiert:
    - Registerkarte Zahlen = Standard
    - Registerkarte Ausrichtung = nichts spezielles
    - Registerkarte Schrift = nichts spezielles
    - Registerkarte Rahmen = Rahmen aussen
    - Registerkarte Ausfüllen = Farbe Rot 255 / Grün 255 / Blau 0
    - Registerkarte Schutz = Haken bei Gesperrt
  8. Mit dem Pinsel diese Formatvorlage auf die Zelle A6 übertragen
  9. Makro „BeforePrint“ von Thomas Ramel unter „DieseArbeitsmappe“im VBA reinkopiert und entsprechend angepasst
  10. Makro „BeforeDoubleClick“ unter „Tabelle1“ im VBA reinkopiert und entsprechend an die neuen Formatvorlagen angepasst
  11. Die gelben und goldigen Zellen entsperrt
  12. Arbeitsmappe unter „Neu.xlsm“ abgespeichert
  13. Arbeitsmappe unter „Aktuelle Tabelle schützen“ mit Passwort „Roger“ geschützt. Haken in „Nicht gesperrte Zellen auswählen“
  14. Arbeitsmappe abspeichern und Excel schliessen
  15. Arbeitsmappe öffnen
  16. Etwas bla-bla-Text eingeben und ausdrucken
  17. „Laufzeitfehler ‚1004‘: Anwendungs- oder objektdefinierter Fehler“ bei „ActiveWorkbook.Styles("Gelb").Interior.Pattern = xlNone“
  18. Im gleichen Arbeitsblatt das Makro „BeforePrint“ von Xpert hineinkopier und entsprechend an die Formatvorlagen angepasst.
  19. Arbeitsmappe unter „Aktuelle Tabelle schützen“ mit Passwort „Roger“ geschützt. Haken in „Nicht gesperrte Zellen auswählen“
  20. Arbeitsmappe abspeichern und Excel schliessen
  21. Arbeitsmappe öffnen
  22. Etwas bla-bla-Text eingeben und ausdrucken
  23. „Laufzeitfehler ‚1004‘: Die IncludeNumber-Eigenschaft des Style-Objektes kann nicht festgelegt werden.“ beim ersten „.IncludeNumber = True“
  24. PrintScreen erstellt und ab ins Forum
Der guten alten Vollständigkeit halber hier noch einmal die beiden Codes:​


Diese Arbeitsmappe:​

Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Code: 
[LEFT]   If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub
[LEFT]   Application.EnableEvents = False
   Cancel = True
   With ActiveWorkbook.Styles("Gelb")
       .IncludeNumber = True
       .IncludeFont = True
       .IncludeAlignment = True
       .IncludeBorder = True
       .IncludePatterns = True
       .IncludeProtection = True
   End With
   ActiveWorkbook.Styles("Gelb").Interior.Pattern = xlNone
   Selection.Style = "Goldig"
   With ActiveWorkbook.Styles("Goldig")
       .IncludeNumber = True
       .IncludeFont = True
       .IncludeAlignment = True
       .IncludeBorder = True
       .IncludePatterns = True
       .IncludeProtection = True
   End With
   ActiveWorkbook.Styles("Goldig").Interior.Pattern = xlNone
   Selection.Style = "Goldig"[/LEFT]
 
 
 
[LEFT]       With ActiveWorkbook.Styles("Gelb")
       .IncludeNumber = True
       .IncludeFont = True
       .IncludeAlignment = True
       .IncludeBorder = True
       .IncludePatterns = True
       .IncludeProtection = True
   End With
   With ActiveWorkbook.Styles("Gelb").Interior
       .ColorIndex = 6
       .PatternColorIndex = xlAutomatic
       .Pattern = xlSolid 'hier voll gefüllt
   End With
   Selection.Style = "Goldig"[/LEFT]
 
[LEFT]   With ActiveWorkbook.Styles("Goldig")
       .IncludeNumber = True
       .IncludeFont = True
       .IncludeAlignment = True
       .IncludeBorder = True
       .IncludePatterns = True
       .IncludeProtection = True
   End With
   With ActiveWorkbook.Styles("Goldig").Interior
       .ColorIndex = 44
       .PatternColorIndex = xlAutomatic
       .Pattern = xlSolid 'hier voll gefüllt
   End With
   Selection.Style = "Goldig"
End Sub[/LEFT]

Tabelle1:
Code: 
Private Sub Worksheet_BeforeDoubleClick( _
[/LEFT]
Code: 
[LEFT]       ByVal Target As Range, Cancel As Boolean)
 
[LEFT]   ActiveSheet.Unprotect Password:="Roger"
' 1 = schwarz   /   2 = weiss   /   36 = hellgelb   /   6 = gelb
   If Target.Interior.ColorIndex = 36 Then
   Target.Interior.ColorIndex = 36
   Selection.Style = ("Gelb")[/LEFT]
 
[LEFT]   ElseIf Target.Interior.ColorIndex = 6 Then
   Target.Interior.ColorIndex = 1[/LEFT]
 
[LEFT]   ElseIf Target.Interior.ColorIndex = 1 Then
   Target.Interior.ColorIndex = 6
   Selection.Style = ("Goldig")[/LEFT]
 
[LEFT]   End If
   Cancel = True
   ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub[/LEFT]


So, jetzt muss ich mal wieder etwas anderes machen hier ...

Ich danke allen schon jetzt ganz herzlich, die sich meines Problems annehmen und wünsche Euch allen ein wunderschönes, erholsames Wochenende ! ! !

Ruppi
[/LEFT]
 

Anhänge

  • Excel.jpg
    Excel.jpg
    44,2 KB · Aufrufe: 5
Xpert

Xpert

Stammgast
Nach dem Schwarz einfärben via Doppelklick ist das Sheet gesperrt. Danach geht das erste Makro natürlich nicht mehr. Dort musst du es auch zuerst wieder entsperren!!!!

Edit: Ich glaube die PrintOut Zeile fehlt auch. Und Thomas hat natürlich recht, da kann man einiges an Code kürzen :-)
 
Zuletzt bearbeitet:
R

Ruppi

Aktives Mitglied
Es ist vollbracht!! Juhuuuuuu!!

Guete Aabig mitenand

Es hat tatsächlich funktioniert!!! Die Entsperrung der Arbeitsmappe hat das ganze Probleme gelöst! Juuuuhuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu ! ! ! !

Für alle, die es interessiert, hier noch einmal der richtige Code:

Diese Arbeitsmappe:
Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub
  ActiveSheet.Unprotect Password:="Roger"
    Application.EnableEvents = False
    Cancel = True
    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlNone    'setzt Yellow auf ohne Füllfarbe
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlNone    'setzt Golden auf ohne Füllfarbe
    ActiveWindow.SelectedSheets.PrintOut
    ActiveWorkbook.Styles("Yellow").Interior.Pattern = xlSolid    'hier voll gefüllt
    ActiveWorkbook.Styles("Golden").Interior.Pattern = xlSolid    'hier voll gefüllt
    Application.EnableEvents = True
   ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Und unter Tabelle1:
Code: 
Private Sub Worksheet_BeforeDoubleClick( _
        ByVal Target As Range, Cancel As Boolean)
 
    ActiveSheet.Unprotect Password:="Roger"
' 1 = schwarz   /   2 = weiss   /   36 = hellgelb   /   6 = gelb
    If Target.Interior.ColorIndex = 36 Then
    Target.Interior.ColorIndex = 36
    Selection.Style = ("Yellow")
 
    ElseIf Target.Interior.ColorIndex = 6 Then
    Target.Interior.ColorIndex = 1
 
    ElseIf Target.Interior.ColorIndex = 1 Then
    Target.Interior.ColorIndex = 6
    Selection.Style = ("Golden")
 
    End If
    Cancel = True
    ActiveSheet.Protect Password:="Roger", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Ich danke Euch allen von ganzem Herzen für Eure Hilfe! Ich bin sehr, sehr froh, dass jetzt alles geklappt hat und dieses Formular läuft. Vielen herzlichen Dank und Euch allen ein wunderschönes und erholsames Wochenende!!!

Ruppi
 
Xpert

Xpert

Stammgast
Ruppi schrieb:
Guete Aabig mitenand

Es hat tatsächlich funktioniert!!! Die Entsperrung der Arbeitsmappe hat das ganze Probleme gelöst! Juuuuhuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu ! ! ! !

(...)
Ich danke Euch allen von ganzem Herzen für Eure Hilfe! Ich bin sehr, sehr froh, dass jetzt alles geklappt hat und dieses Formular läuft. Vielen herzlichen Dank und Euch allen ein wunderschönes und erholsames Wochenende!!!

Ruppi
Zum Vergrößern anklicken....

Uff, das höre ich gern :)
 
Du musst dich einloggen oder registrieren, um hier zu antworten.
Oben