Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Autoform als Ampel (VBA Code optimieren)

Thema geschlossen 
Baumstrukturmodus
Autoform als Ampel (VBA Code optimieren)
M.Wichmann Offline
Benutzer
ThreadStarter

Registriert seit: 06.03.2017
Version(en): 2007
#21
07.07.2017, 08:31
Hallo,

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.
Grüße Mario  Angel
Suchen
Antworten Top
M.Wichmann Offline
Benutzer
ThreadStarter

Registriert seit: 06.03.2017
Version(en): 2007
#22
11.07.2017, 10:22
Hallo noch mal,


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
       
  End If
  End If
  End If
  End If
 
 
 
 
End Sub
Grüße Mario  Angel
Suchen
Antworten Top
Rabe Offline
:-)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#23
11.07.2017, 10:46
Hi Mario,

hast Du schon eine Beispieldatei hochgeladen?
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#24
11.07.2017, 11:01
Hallo Mario,

(11.07.2017, 10: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
Gruß Uwe
Suchen
Antworten Top
M.Wichmann Offline
Benutzer
ThreadStarter

Registriert seit: 06.03.2017
Version(en): 2007
#25
11.07.2017, 11:23
Hallo, jetzt ja^^ 

Datei im Anhang mit jedem Fall einzeln.

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
       
  End If
  End If
  End If
  End If
 
 
 
 
End Sub


Angehängte Dateien
.xlsm   Forum.xlsm (Größe: 19,38 KB / Downloads: 1)
Grüße Mario  Angel
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#26
11.07.2017, 11:54
Hallo,

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.
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
M.Wichmann Offline
Benutzer
ThreadStarter

Registriert seit: 06.03.2017
Version(en): 2007
#27
11.07.2017, 12:37 (Dieser Beitrag wurde zuletzt bearbeitet: 11.07.2017, 12: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)
Grüße Mario  Angel
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#28
11.07.2017, 12:38
Hallo Mario,

(11.07.2017, 12: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)

mache aus dem ActiveSheet ein Me.
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
M.Wichmann Offline
Benutzer
ThreadStarter

Registriert seit: 06.03.2017
Version(en): 2007
#29
11.07.2017, 12:43
Hallo, danke.

Fehler scheint weg zu sein.
Grüße Mario  Angel
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste