AW: Formen
25.03.2007 16:26:00
Marcus
Hallo!
Ersteinmal vielen vielen Dank für die Zeit und die Hilfe. Ist wirklich super.
Habe den Quellcode jetzt mal eingeben, doch habe das Problem das bei einem wechsel der zustände von 0 auf 1 keine automatische Änderung erfolgt. Muss ich die Abarbeitung des Codes irgendwie zyklisch ausführen lassen o.ä?
Habe den Quellcode mal angehangen, vielleicht könnt ihr mir nocheinmal helfen...
Gruß Marcus
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Cells(3, 4), Cells(4, 4), Cells(5, 4), Cells(7, 4), Cells(8, 4)) Is _
Nothing Then
Dim AR As Boolean
Dim AGL As Boolean
Dim AGR As Boolean
Dim FR As Boolean
Dim FGR As Boolean
If Cells(3, 4) = 1 Then AR = True
If Cells(3, 4) 1 Then AR = False
If Cells(4, 4) = 1 Then AGL = True
If Cells(4, 4) 1 Then AGL = False
If Cells(5, 4) = 1 Then AGR = True
If Cells(5, 4) 1 Then AGR = False
If Cells(7, 4) = 1 Then FR = True
If Cells(7, 4) 1 Then FR = False
If Cells(8, 4) = 1 Then FGR = True
If Cells(8, 4) 1 Then FGR = False
If AR = True Then
ActiveSheet.Shapes("AutoRot").Visible = True
ActiveSheet.Shapes("AutoGelb").Visible = False
ActiveSheet.Shapes("AutoGruen").Visible = False
End If
If AGL = True Then
ActiveSheet.Shapes("AutoRot").Visible = False
ActiveSheet.Shapes("AutoGelb").Visible = True
ActiveSheet.Shapes("AutoGruen").Visible = False
End If
If AGR = True Then
ActiveSheet.Shapes("AutoRot").Visible = False
ActiveSheet.Shapes("AutoGelb").Visible = False
ActiveSheet.Shapes("AutoGruen").Visible = True
End If
If FR = True Then
ActiveSheet.Shapes("FussRot").Visible = True
ActiveSheet.Shapes("FussGruen").Visible = False
End If
If FGR = True Then
ActiveSheet.Shapes("FussRot").Visible = False
ActiveSheet.Shapes("FussGruen").Visible = True
End If
End If
End Sub
Sub AmpelLicht_KlickenSieAuf()
ActiveSheet.Shapes("AutoRot").Visible = True
ActiveSheet.Shapes("AutoGelb").Visible = True
ActiveSheet.Shapes("AutoGruen").Visible = True
ActiveSheet.Shapes("FussRot").Visible = True
ActiveSheet.Shapes("FussGruen").Visible = True
End Sub
