Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Makro bei bestimmten Wert in Zelle starten
06.05.2016 22:47:27
Stefan
Hallo!
Habe folgendes Problem. Ich möchte das ein Makro automatisch gestartet wird, wenn ein bestimmter Wert in der Zelle K3 eingetragen wird.
Ich habe 4 Makros, und je nach Wert, sollen dann bestimmte Bereiche in meiner Tabelle mit einer bestimmten Farbe eingefärbt werden.
Das hab ich jetzt direkt in meinem Arbeitsblatt eingetragen. Das Problem ist, dass das Makro immer wieder ausgeführt wird, bis sich Excel aufhängt. Manchmal kommt auch die Meldung "Nicht genügend Stapelspeicher" Laufzeitfehler 28. Private Sub Worksheet_Calculate() Select Case Range("K3").Value Case Is = 5 Switch5_Orange Case Is = 6 Switch6_Grün Case Is = 7 Switch7_Rot Case Is = False Switch_FALSE End Select End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("K3")) Is Nothing Then
Select Case Target.Value
Case Is = 5
Switch5_Orange
Case Is = 6
Switch6_Grün
Case Is = 7
Switch7_Rot
Case Is = False
Switch_FALSE
End Select
End If
End Sub
Das ist jetzt zb. Mein Makro Switch5_Orange, dass mir die Bereiche vom Arbeitsblatt Orange färben soll. Die 4 Makros sind alle gleich nur sind es unterschiedliche Farben.
Wenn das Makro einem Button zuordne funktioniert es einwandfrei. Nur so leider nicht.
Sub Switch5_Orange()
'
' Makro1 Makro
'
ActiveSheet.Unprotect
Range("A1:AD1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("G2:AD23").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A3:G3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A7:G8").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("D7:G12").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A11:E12").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=3
Range("A14:F15").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A28:AD29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("J24:AD29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveWindow.LargeScroll ToRight:=-1
Range("F27:I27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("F12:F28").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A4:A133").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=15
Range("B32:AD133").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("G30:I31").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("L30:AD33").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=-18
ActiveWindow.LargeScroll ToRight:=-1
Range("A2:A4").Select
Range("A4").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("G1:J7").Select
With Selection.Font
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
Range("N8:U23").Select
With Selection.Font
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
Range("H3:I3").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("O12").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O13").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O14").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O15").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O16").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O17").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("O18").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("B5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True_, AllowFiltering:=True
End Sub Hat einer eine Idee wo mein Fehler ist?

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro bei bestimmten Wert in Zelle starten
07.05.2016 05:11:35
Matthias
Hallo
Durch ... Worksheet_Calculate
und Worksheet_Change
wird das Makro wieder immer wieder neu angestoßen.


Noch ein Hinweis
Dieses ganze Select ist nicht nötig!
z.B. so: (noch nicht optimiert!)
Sub Switch5_Orange()
ActiveSheet.Unprotect
With Range("A1:AD1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("G2:AD23").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A3:G3").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A7:G8").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("D7:G12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A11:E12").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A14:F15").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A28:AD29").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("J24:AD29").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("F27:I27").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("F12:F28").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A4:A133").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("B32:AD133").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("G30:I31").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("L30:AD33").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("A2:A4").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Range("G1:J7").Font
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
With Range("N8:U23").Font
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
With Range("H3:I3").Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Range("O12:O16")
.FormulaR1C1 = "FALSE"
End With
With Range("O17:O18")
.FormulaR1C1 = "TRUE"
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True_, AllowFiltering:= _
True
End Sub

Mit noch nicht optimiert! meine ich das Du die einzelnen Range in einer Union zusammenfassen kannst.
z.B. so:(nur als Bsp. mal mit 4 Bereichen)

With Union(Range("A1:AD1"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Alle Range mit den gleichen Formatierungen packst Du so in eine Union.
Da wird auch nichts markiert(Select), sondern die Bereiche werden nur referenziert.
Prinzip verstanden?
Gruß Matthias

Anzeige
AW: Makro bei bestimmten Wert in Zelle starten
07.05.2016 10:32:52
Stefan
Hallo Matthias!
Danke mal für deine Antwort.
Wie muss der Befehl dann statt Worksheet_Calculate oder Worksheet_Change heißen? Das er das Makro nur einmal ausführt?
Ok das mit der Union wusste ich nicht, hab dass aber ganz einfach nur mit dem Makrorecorder aufgezeichnet, deshalb schaut es so aus. Aber jetzt ist es mir klar dass ich es auch zusammen fassen kann. Danke

AW: Makro bei bestimmten Wert in Zelle starten
07.05.2016 10:41:11
Werner
Hallo Stefan,
wenn der Wert in K3 händisch eingetragen wird dann das Change-Ereignis
wenn der Wert in K3 durch eine Formel ausgegeben wird dann das Calculate-Ereignis
nicht beide gleichzeitig.
Gruß Werner

Anzeige
AW: Makro bei bestimmten Wert in Zelle starten
07.05.2016 10:42:27
Matthias
Hallo
Warum benutzt Du denn Worksheet_Calculate
Steht die Berechnung in den Optionen auf Manuell?
Setze im Worksheet_Change zu Beginn Application.EnableEvents auf False
und vor End Sub wieder auf True
Ein weiterer kleiner Fehler ist hier:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True_, AllowFiltering:=True
Der Unterstrich hinter True hat dort nichts zu suchen.
Gruß Matthias

AW: Makro bei bestimmten Wert in Zelle starten
07.05.2016 11:16:11
Stefan
Hallo Werner!
Ok hab das Change jetzt rausgenommen, aber es läuft noch immer mehrmals durch.
Zur Erklärung, ich habe eine Tabelle mit Formeln wo die Arbeitstage berechnet werden. Dabei hast du mir schon mal geholfen Werner, vielleicht erinnerst du dich noch daran.
Hab die jetzt weiter angepasst mit der Verketten Funktion und hab jetzt Checkboxen dazu gemacht, wo ich mit Klick die Tage auswählen kann.
=NETTOARBEITSTAGE.INTL(B17;C17;VERKETTEN($O$12*1;$O$13*1;$O$14*1;$O$15*1;$O$16*1;$O$17*1;$O$18*1); WENN($G$1;Feiertage!B$3:J$17;0))+ZÄHLENWENNS(G$25:I$26;">="&B18;G$25:I$26;"
Damit man jetzt sofort sieht, welche Tage Aktiv sind, will ich dass das Arbeitsblatt auch eine bestimmte Farbe bekommt.
In der Zelle H3 hab ich mir dann diese Formel gemacht
=WENN(UND(P19=2;N17=2);"5 Tage ist aktiv";WENN(UND(O12=FALSCH;O13=FALSCH;O14=FALSCH;O15=FALSCH; O16=FALSCH;O17=FALSCH;O18=WAHR);"6 Tage ist aktiv";WENN(P19=0;"7 Tage ist aktiv";WENN(P19>=1; "Freie Auswahl aktiviert")))) 
Und in K3 mich dann einfach darauf bezogen, damit es als Zahl für mein Makro dargestellt wird, und sobald der bestimmte Wert dann kommt, soll das Makro mit den Farben ausgeführt werden.
=WENN(H3="7 Tage ist aktiv";7;WENN(H3="6 Tage ist aktiv";6;WENN(H3="5 Tage ist aktiv";5)))
Ist vermutlich jetzt nicht so einfach nachzuvollziehen, aber sonst werd ich eine Bsp Tabelle hochladen.
Aber laut dir Werner müsst ich dann das Calculate-Ereignis nutzen, und da wird es wieder ewig lang ausgeführt, bis abstürzt.
Irgendwas mach ich falsch.
Zu Matthias wo muss ich das Application.EnableEvents auf False genau einfügen?
Zu ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True_, AllowFiltering:=True
Da bin ich wohl versehentlich angekommen und hab den "_" eingefügt, und ist mir nicht aufgefallen. Danke hab ich jetzt mal korrigiert.

Anzeige
AW: hier ein abgespecktes Beispiel ...
07.05.2016 17:09:16
Stefan
Danke Matthias hab jetzt deine Vorlage auf Calculate umgeschrieben, weil er sonst nur mit Eingabe die Farben gewechselt hat.
Und fast ist es schon wie ich es gern hätte. Ich hab bei meiner Datei, noch 3 Schaltflächen, 5 Tage, 6 Tage und 7 Tage, wo es direkt durch klick auf den Button die Farbe wechseln soll.
Wenn ich meine Checkboxen bei den Tagen anklicke, geht der Übergang mit den Farben schön fließend. Drücke ich aber auf mein Makro über den Button, dann dauert es immer ein wenig um man sieht den Übergang.
Kann man das noch irgendwie ändern? Und wie kann ich bei dir die Farben auf meine Anpassen? Ich brauche 4 Farben, wie in meiner Vorlage.

Case Is = 5
Farbe = vbYellow
Case Is = 6
Farbe = vbGreen
Case Is = 7
Farbe = vbRed
Case Else
Farbe = -4142
Der Farbcode bezieht sich auf den Teil oder? Wie änder ich das auf meine gewünschten Farben?
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
Komischerweise hab ich jetzt meine Datei in ein neues Arbeitsblatt kopiert und die Farben stimmen jetzt nicht mehr. Obwohl das Makro das gleiche ist? Irgendwie hat sich da die Farbanordnung geändert, kann das mit unterschiedlichen Excel Versionen zusammenhängen?
Ich lade mal meine Vorlage hoch, dann ist es sicher leichter verständlich.
https://www.herber.de/bbs/user/105436.xlsm

Anzeige
es ist immer ein Vorteil gleich alles zu zeigen ..
07.05.2016 18:12:43
Matthias
Hallo
Es ist immer ein Vorteil gleich alles zu zeigen, bzw. zu erklären was man wirklich möchte!
Wenn Du Worksheet_Change nicht benutzen willst, kann ich Dir auch nicht mehr helfen.
Jedesmal eine andere Datei neu zu analysieren, dazu habe ich schon lange keine Lust mehr.
Ich muss jedes Mal, jede Codezeile neu prüfen ob da irgend etwas anders ist als in der vorherigen Version,
bzw. ob da irgend ein "böser Code" versteckt ist.
Letzteres hat überhaupt nichts mit Dir zu tun, das mache ich immer so!(Systemschutz)
Gruß Matthias

AW: es ist immer ein Vorteil gleich alles zu zeigen ..
07.05.2016 18:27:52
Stefan
Hallo
Vorweg ich dachte, es ist nur eine Kleinigkeit, was bei meinem Makro nicht stimmt, somit hab ich nicht gleich eine Vorlage hochgeladen.
Meine Kenntnisse reichen aber leider nicht aus, dass ich es alleine schaffe. Und deswegen weiß ich auch nicht, welcher Code dann wieder Auswirkungen auf etwas anderes hat, so wie auf meine Buttons.
Und da kommt man dann erst durch herumprobieren drauf.
Option Explicit
Public Farbe
Private Sub Worksheet_Calculate()
Select Case Range("K3").Value
'Select Case Target.Value
Case Is = 5
Farbe = vbYellow
Case Is = 6
Farbe = vbGreen
Case Is = 7
Farbe = vbRed
Case Else
Farbe = -4142
End Select
Switch5_Farbe
Application.EnableEvents = True
End Sub
'Das ist jetzt das Makro Switch5_Farbe, dass die Bereiche vom Arbeitsblatt färbt
Sub Switch5_Farbe()
ActiveSheet.Unprotect
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:= _
True
End Sub
Deinen Code hab ich so geändert. Kannst du mir Bitte vielleicht einfach nur noch erklären, wie ich die Farben auf meine gewünschte Farben anpassen kann? Dann wäre mir auch schon sehr geholfen.
Mir ist schon klar, dass Sicherheit auch sehr wichtig ist, aber ohne Makros kann ich die Datei ja nicht raufladen, bzw damit es verständlich bleibt.
Das wäre der Farbcode für Orange
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
Der für Rot
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
Der für Grün
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
Der wenn weder 5, 6 oder 7 zutrifft
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
Wie kann ich diese in deinen Code einbauen?

Anzeige
@Matthias & Werner
08.05.2016 15:14:52
Stefan
So hab mich jetzt ein wenig damit herumgespielt und ich hab es jetzt fast hinbekommen.
Hab den Code jetzt so wie darunter ersichtlich abgeändert, und auch der Übergang zwischen den Farben verläuft jetzt fast fließend. Jetzt hab ich nur ein neues Problem. Ich habe eine weitere Tabelle mit Formeln und Makros, und komischerweise funktionieren jetzt dort meine Makros bzw. die Formeln nicht immer.
Wenn ich in der Tabelle mit dem Code darunter etwas arbeite, hat es scheinbar auch Auswirkungen, auf meine Makros bzw. das die Formeln berechnet werden in der anderen Tabelle, obwohl ich die "Private Sub" direkt in der Tabelle6 hinterlegt hab, Hab ich eben die Probleme jetzt bei Tabelle1.
Kann Bitte nochmal jemand drüber schauen, wo mein Fehler liegt? Matthias, Werner oder jemand anderes?
Option Explicit
Public Farbe
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Select Case Range("K3").Value
'Select Case Target.Value
Case Is = 5
Switch5_Farbe_Orange
Case Is = 6
Switch6_Farbe_Grün
Case Is = 7
Switch7_Farbe_Rot
Case Else
Switch_FALSCH_Blau
End Select
Application.EnableEvents = True
End Sub

Sub Switch6_Farbe_Grün()
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With
End Sub
Sub Switch5_Farbe_Orange()
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With
End Sub
Sub Switch7_Farbe_Rot()
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With
End Sub
Sub Switch_FALSCH_Blau()
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With
End Sub

Anzeige
AW: @Matthias & Werner
09.05.2016 22:00:41
Stefan
Hallo Matthias!
Vielen Dank für deine Hilfe ich war schon leicht am verzweifeln.
Ein Problem hab ich aber weiterhin, ich möchte wenn ich den Button 5 Tage, 6 Tage bzw. 7 Tage drücke, dass bei der Checkbox unten bei den Tagen diese auch aktiviert sind. Dann kommt in der Zelle H3 auch die Meldung welche Tage aktiv sind.
Wenn ich den Code so erweitere, funktioniert das zwar einwandfrei. Geh ich aber in meine Tabelle1 zurück und führe ein Makro aus, färbt er mir auf einmal auch diese Tabelle um. Obwohl der Code ja diese Tabelle nicht betreffen sollte mit den Farben. Oder kann man die Checkboxen irgendwie anders definieren das diese ausgewählt werden? Den wenn ich direkt es über die Checkboxen auswähle funktioniert auch die andere Tabelle einwandfrei. Mach es ist mit diesen Zusatz siehe darunter hab ich das Problem

Range("O12").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O13").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O14").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O15").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O16").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O17").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O18").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("B5").Select

Darunter jetzt der komplette Code für die "6 Tage" und Farbe grün. Der Code wird für 5 Tage bzw. 7 Tage einfach mit FALSE oder TRUE angepasst/erweitert. Das heißt wenn ich auf das Makro 5 Tage drücke, soll unten auch bei Samstag und Sonntag die Hackerl sein usw.
Sub Switch6_Farbe_Grün1()
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("O12").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O13").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O14").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O15").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O16").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O17").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("O18").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("B5").Select
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:= _
True
End Sub

Anzeige
AW: @Matthias & Werner
10.05.2016 12:06:17
Werner
Hallo Stefan,
meinst das so?
Die Formel in Zelle K3 habe ich raus geschmissen, da ich in deinem Select Case jetzt direkt die Zelle H3 abfrage.
Wenn du nur den Code in deine Originaldatei überträgst, dann musst du den einzelnen Auswahlboxen noch das jeweilige Makro für das Klick-Event zuordnen.
Übrigens deine Farben passen nicht zu den Bezeichnungen.
https://www.herber.de/bbs/user/105482.xlsm
Gruß Werner

AW: @Matthias & Werner
10.05.2016 21:04:54
Stefan
Hallo Werner!
Danke für die Antwort. Nein so funktioniert es leider auch nicht. Da ändert sich dann durch klicken, der Checkboxen nicht die Farbe des Tabellenblattes. Außerdem stimmt auch die Formel nicht welche "Tage grad aktiv" sind.
Der Grund des ganzen ist, wenn "5-Tage aktiv" ist, soll ein Hackerl bei Sa und So sein. Diese Tage sind dann arbeitsfreie Tage usw.
Wollte es dynamisch haben, den es gibt Mitarbeiter die haben nicht nur Arbeitage von Mo-Fr oder Mo-Sa bzw. Mo - So, sondern auch komplett gemischte Tage. Aber am häufigsten kommen halt die 3 genannten vor, deswegen das extra Makro zum direkt auswählen, ohne das man die Checkboxen alle anklicken muss.
Was die Farben betrifft da hast du Recht, aber das dürfte an unterschiedlichen Excel Versionen liegen. Die Codetabelle mit den Farben hab ich in der Arbeit gemacht mit einer älteren Excel Version, und meine Vorlage die ich hier hochgeladen habe daheim, mit der neuesten Version.
Ich glaube das Problem ist dieser Teil, der ja das flackern bei der Berechnung von Excel unterbinden soll. Den wenn ich den Teil raus nehme, funktioniert es scheinbar. Hab irgendwie den Eindruck als hängt Excel dann noch in der Berechnung fest, und übernimmt deswegen auch die Farbe, von der anderen Tabelle, obwohl kein Code im Arbeitsblatt ist.
Hat jemand eine Idee dazu?
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

Mir ist auch aufgefallen, dass ich jetzt im Makro, mehrmals vor jeder Formel die das Makro ausführen soll extra den Blattschutz aufheben muss.
Das ist ein Makro was auch in der Tabelle mit den Farben läuft, und durch einen Button aktiviert wird. Ich hab aber keine Ahnung warum. Wenn ich nicht ActiveSheet.Unprotect direkt davor nochmal reinschreibe führt Excel das Makro nur mit Fehler aus und bricht ab.
    ActiveSheet.Unprotect
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Range("C5").Select
ActiveCell.FormulaR1C1 = "=IF(R[22]C[1]="""",R[7]C[16],R[7]C[16]-R[22]C[1])"
Range("C6").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C[-1]="""","""",IF(R[-1]C="""","""",IF(R[-1]C,R[6]C[17],"""")))"
Range("C31").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = _
"=IF((RC[-1]="""")+(R[-4]C[1]=""""),"""",(R[-19]C[17]-R[-4]C[1]))"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("B5").Select
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:= _
True
End Sub

Was die Checkboxen betrifft, hab ich das jetzt so gelöst, hat aber auch nichts gebracht. Nicht wundern, die hohen Nummer bei den Check Boxen, sind in meiner Tabelle, in der Vorlage sind sie noch niedriger. Die hab ich halt dann auch angepasst an die Tage.
Tabelle6.Shapes("Check Box 31").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 32").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 33").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 39").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 35").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 36").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 41").ControlFormat.Value = 1
Wenn ich den Code jetzt so umändere mit Application.ScreenUpdating = False und dann wieder True funktioniert es, nur das flackern ist da. Ich hab echt keine Ahnung woran das noch liegen könnte. Ich hoffe ihr findet eine Lösung bzw. den Fehler. Mit dem Code darunter funktioniert es.
Sub Switch6_Farbe_Grün()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
With Union(Range("A2:A4"), Range("L30:AD33"), Range("A1:AD1"), Range("G30:I31"), Range("B32: _
AD133"), Range("A4:A133"), Range("F12:F28"), Range("A3:G3"), Range("A7:G8"), Range("A11:E12"), Range("A14:F15"), Range("A28:AD29"), Range("D7:G12"), Range("F27:I27"), Range("G2:AD23"), Range("J24:AD29")).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Tabelle6.Shapes("Check Box 31").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 32").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 33").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 39").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 35").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 36").ControlFormat.Value = 0
Tabelle6.Shapes("Check Box 41").ControlFormat.Value = 1
Range("B5").Select
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:= _
True
End Sub

Anzeige
AW: @Matthias & Werner
11.05.2016 10:36:46
Werner
Hallo Stefan,
meinst du so?
https://www.herber.de/bbs/user/105500.xlsm
Betrifft jetzt aber nur die Sache mit den Checkboxen.
Jetzt kommst du wieder mit einem weiteren Code Schnipsel um die Ecke, von dem vorher niemand etwas wusste.
Zudem hast du auf dem Blatt Formeln versteckt die ich mir auch nicht angesehen habe.
Gruß Werner

@Werner ...
11.05.2016 13:00:18
Matthias
Hallo Werner
Wenn Du diese Formeln meinst, die hatte ich umformatiert.
Womöglich hat es Stefan ja noch nicht einmal bemerkt.
Test

 OPQRST
12FALSCH0 63020
13FALSCH0 840 
14FALSCH0 1050 
15FALSCH0 1260 
16FALSCH0 420 
17WAHR1    
18WAHR1    
19Summe2    

Formeln der Tabelle
ZelleFormel
P12=WENN(O12=WAHR;1;0)
S12=(7-$P$19)*R12
T12=(7-$P$19)*4
P13=WENN(O13=WAHR;1;0)
S13=(7-$P$19)*R13
P14=WENN(O14=WAHR;1;0)
S14=(7-$P$19)*R14
P15=WENN(O15=WAHR;1;0)
S15=(7-$P$19)*R15
P16=WENN(O16=WAHR;1;0)
S16=(7-$P$19)*R16
P17=WENN(O17=WAHR;1;0)
P18=WENN(O18=WAHR;1;0)
P19=SUMME(P12:P18)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Format: ;;;
Ich werde aber ab jetzt hier nicht mehr weiter tätig sein.
Das ist mir zu viel Durcheinander.
Gruß Matthias

Anzeige
AW: @Matthias..
11.05.2016 19:39:26
Werner
Hallo Matthias,
ich hoffe mal, dass du mit dem Durcheinander jetzt nicht mich meinst.
Gruß Werner

AW: @Matthias..
11.05.2016 22:38:37
Stefan
Hallo Werner und Matthias!
Zu dir Matthias, das mit dem Format ;;; war absichtlich gewählt, damit ich nicht noch zusätzlich die Schrift mit meinen Hilfswerten extra auf die richtige Farbe umfärben muss.
Und mit dem Durcheinander wird er mich meinen Werner, tut mir leid aber ist nicht so einfach das alles zu erklären wie ich es gern hätte, da jeder Aussagen unterschiedlich auffasst.
Ich versteh z.b. nicht, warum mein simples Makro, wo nur im Prinzip 2 Formeln rein kopiert und die Feiertage aktiviert werden meine andere Tabelle umfärbt.
Werner genauso wie du es mit den Checkboxen jetzt gemacht hast, passt das. Danke
Das 1. Problem ist weiterhin, dass man bei der Ausführung vom Makro das flackern sieht genauso wie bei dem Wechsel wenn man die Checkboxen anklickt. Obwohl es eigentlich unterbunden sein sollte. Versteh das nicht.
Und das 2. Problem ist eben das die andere Tabelle die Farbe mitwechselt. Ich hänge dafür jetzt eine neue Vorlage von mir an, da sieht man es dann deutlich was ich meine.
https://www.herber.de/bbs/user/105517.xlsm
1. In Tabelle 6 auf auf den Button oben "Makro 5 Tage" klicken" --> Tabelle 6 färbt sich grün
2. Dann auf Tabelle 1 wechseln, dann in Zelle B5 irgendein Datum eintragen, Tabelle 1 färbt sich auch grün? Obwohl die Farbe von Tabelle1 immer grau sein soll. Es wird auch im Bereich O12:O12 "WAHR" eingetragen, obwohl das für die Tabelle1 nicht notwendig und gewünscht ist. Es wirkt so als führt er das Makro von Tabelle 6 weiterhin aus.
3. Hab es nochmal getestet und jetzt ist der Fehler auch wenn man die Checkboxen anklickt, und Punkt 1 und 2 wiederholt. Tabelle 1 wechselt die Farbe einfach von Tabelle 6 mit. Manchmal muss man das Makro1 oder Makro2 anklicken und auch da ändert sich dann die Farbe.
Ich glaube es liegt an dem Bereich im Code, der das Flackern beim Aufruf unterbinden soll. Aber versteh auch da nicht warum das nicht richtig funktioniert.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

@Werner: Nein ich meinte Dich nicht ... owT
12.05.2016 04:38:53
Matthias

@Werner
13.05.2016 07:15:14
Stefan
Hast du auch keine Idee mehr, wie ich das Problem lösen kann?

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige