ich wollte zum hochladen eine Kopie des Blattes erstellen. Dabei habe ich festgestellt, das wenn ich nur diese Testdatei offen habe, alles so funktioniert wie es soll. Aber wenn ich die eigentliche Datei offen habe, kommt es sobald ich irgendwo was eingebe zum Fehler. Sogar der Code in der Testdatei führt zum Fehler. Also scheint es ein Problem mit irgend einem anderen Code in der Datei zu geben. Da ich mittlerweile in dieser Datei mehrere Arbeitsmappen zusammengeführt habe, und ich schon sehr viele andere Makro drin habe die das verursachen könnten, gebe ich den Plan auf und setze das anders um.
Es sei denn, es gibt mir jemand einen Ansatz wie ich das evtl direkt im Makro berechnen kann.
Also wie so eine Formel mit dem Datum aussehen sollte, werde dazu aber auch noch google bemühen.
Ansonsten Danke an alle die sich beteiligt haben, werde den Code auf jeden Fall aufheben.
ich habe mich noch mal damit beschäftigt und ich glaube auch was hinbekommen das funktioniert. Im Moment simuliere ich das Datum über ein Drehfeld. Wenn das datum nach oben geht funktioniert alles wie es soll. Aber wenn das Datum in die Vergangenheit springt, und alle auf grün springen sollten, schaltet nur der erste.
Ich nehme mal an, das der Code stehen bleibt wenn der erste Fall eintritt. Wie baue ich da eine Schleife ein, damit er alle 3 umschaltet?
Hier der aktuelle Code:
Code:
Option Explicit
Private Sub Worksheet_Calculate() 'If ActiveSheet.ToggleButton1 Then
If Range("B33") = 5 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("B33") = 4 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("B33") = 2 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If
End If If Range("D33") = 5 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("D33") = 4 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("D33") = 2 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End If If Range("F33") = 5 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("F33") = 4 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("F33") = 2 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If
(11.07.2017, 11:22)M.Wichmann schrieb: Ich nehme mal an, das der Code stehen bleibt wenn der erste Fall eintritt. Wie baue ich da eine Schleife ein, damit er alle 3 umschaltet?
mit Schleifen hat das wahrscheinlich weniger zu tun.
Aber einen Tipp hätte ich: Benutze die Einrückungen des Codes "richtig", dann ist die Logik gleich viel verständlicher. So meinte ich es:
Private Sub Worksheet_Calculate() 'If ActiveSheet.ToggleButton1 Then
If Range("B33") = 5 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("B33") = 4 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("B33") = 2 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End If If Range("D33") = 5 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("D33") = 4 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("D33") = 2 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End If If Range("F33") = 5 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("F33") = 4 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("F33") = 2 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End If End If End If End If End Sub
Ich habe mir erst einmal damit beholfen, das ich den Fall Grün für alle 3 zusammengefasst habe.
Code:
Option Explicit
Private Sub Worksheet_Calculate() 'If ActiveSheet.ToggleButton1 Then
If Range("B33") = 5 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("B33") = 4 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("B33") = 2 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If
End If If Range("D33") = 5 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("D33") = 4 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("D33") = 2 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End If If Range("F33") = 5 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 Else If Range("F33") = 4 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 Else If Range("F33") = 2 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If
imho passt da aber was nicht. Entweder willst Du die Zelle B33 nur für die Prüfung des Shapes Wartung hernehmen oder oder es ist egal welche Zelle für welches Shape gelten soll. Für den Fall das Zelle B33 für das Shape Wartung, die Zelle D33 für das Shape Prüfmittel und die Zelle F33 für das Shape Messmittel gelten soll, könntest Du es so machen.
Code:
Private Sub Worksheet_Calculate() 'If ActiveSheet.ToggleButton1 Then
If Range("B33") = 5 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 ElseIf Range("B33") = 4 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 ElseIf Range("B33") = 2 Then ActiveSheet.Shapes("Wartung").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If If Range("D33") = 5 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 ElseIf Range("D33") = 4 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 ElseIf Range("D33") = 2 Then ActiveSheet.Shapes("Prüfmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If If Range("F33") = 5 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 11 ElseIf Range("F33") = 4 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 10 ElseIf Range("F33") = 2 Then ActiveSheet.Shapes("Messmittel").DrawingObject.ShapeRange.Fill.ForeColor.SchemeColor = 5 End If End Sub
PS: Du solltest wirklich den Rat von Uwe befolgen und die Einrückungen richtig setzen.
11.07.2017, 13:37 (Dieser Beitrag wurde zuletzt bearbeitet: 11.07.2017, 13:37 von M.Wichmann.)
Hallo,
Danke Code funktioniert nach meinem ersten kurzen Test. Und ja, ich Frage für jedes Element eine andere Zelle ab. Habe ja verschiedene Umschaltpunkte auf der Zeitachse.
Das mit dem einrücken werde ich in Zukunft versuchen umzusetzen.
Aber eins wäre da noch, manchmal wenn ich zusätzlich eine andere Datei öffne, kommt es zum Fehler mit diesem Code. (Fehler weil er die angegebene Form nicht findet)
(11.07.2017, 13:37)M.Wichmann schrieb: Aber eins wäre da noch, manchmal wenn ich zusätzlich eine andere Datei öffne, kommt es zum Fehler mit diesem Code. (Fehler weil er die angegebene Form nicht findet)
