VBA Ampel

[michel34497]

tHallo,

ich habe mir eine Ampel zusammen gebastel, die über eine VBA Code gesteuert wird und habe damit folgendes Problem!

Beschreibung:

Wenn der Button gedrückt wird soll dieser Code ausgefürt werden

Code:

Private Sub CommandButton1_Click()
i = Sheets("Starttest").Range("N10")
If i >= 3 Then
Sheets("Starttest").Range("N10") = 1
Else



i = i + 1
Sheets("Starttest").Range("N10") = i
End If

'
'Sheets("Start").Range ("N10") + 1
AmpelWart10

End Sub


Modul1

Sub AmpelWart10()

Dim i, a, X As Integer
Dim Farbe10 As String
Dim Transp As Integer




'Ampel einschalten
ActiveSheet.Shapes.Range(Array("Gelb", "Grün", "Rot")).Fill.Transparency = 0
Application.Wait Now + TimeSerial(0, 0, 5)

  i = Sheets("Starttest").Range("N10")
        Farbe10 = "Rot"
        Transp = 0
       
  For a = 1 To 3
       With ActiveSheet.Shapes.Range(Array(Farbe10)).Fill
            .Visible = msoTrue
            .Transparency = Transp
            .Solid
       End With

If i = 1 And a = 1 Then                 'Gelb und Rot Ausblenden
  Farbe10 = "Gelb"
  Transp = 0.7
    ElseIf i = 1 And a = 2 Then
        Farbe10 = "Rot"
        Transp = 0.7
            ElseIf i = 2 And a = 1 Then                 'Rot und Grün Ausblenden
                Farbe10 = "Rot"
                Transp = 0.7
                    ElseIf i = 2 And a = 2 Then
                        Farbe10 = "Grün"
                        Transp = 0.7
                            ElseIf i = 3 And a = 1 Then
                                Farbe10 = "Gelb"
                                Transp = 0.7
                                    ElseIf i = 3 And a = 2 Then
                                        Farbe10 = "Grün"
                                        Transp = 0.7
End If
       Next a

End Sub

Im Modul1 gibt es die Zeile

Code:

ActiveSheet.Shapes.Range(Array("Gelb", "Grün", "Rot")).Fill.Transparency = 0

Da nach startet eine Wartezeit damit ich sehe ob die Lampen alle eingeblendet sind!

Genau das Funtzt Nicht!

Was ist falsch am Code?

[michel34497]

Habe es gefunden;

Code:

Application.ScreenUpdating = False
'Ampel einschalten
    ActiveSheet.Shapes.Range(Array("AWASGelb", "AWASGrün", "AWASRot")).Fill.Transparency = 0
Application.ScreenUpdating = True