Sub ClignoteStations()
Static Passe%
'---
Sheets("SCHEME").Select
Passe% = Passe% + 1
If Passe% > 20 Then
Passe% = 0
Exit Sub
End If
Call Stations
Application.OnTime Now + TimeValue("00:00:01"), "ClignoteStations"
End Sub
Sub ClignoteRoutes()
Static Passe%
'---
Sheets("SCHEME").Select
Passe% = Passe% + 1
If Passe% > 20 Then
Passe% = 0
Exit Sub
End If
Call Routes
Application.OnTime Now + TimeValue("00:00:01"), "ClignoteRoutes"
End Sub
Private Sub Stations()
Static Passe%
Dim S As Worksheet
Dim R As Range
Dim i&
Dim A%
'---
If Passe = 0 Then
Set S = Sheets("Stations1")
Passe = 1
Else
Set S = Sheets("Stations2")
Passe = 0
End If
'---
Set R = S.Range("L3")
Application.ScreenUpdating = False
With S
For i = 1 To 45
Select Case .Range(R.Address).Offset(i - 1, 0).Value
Case Is <= 1
A = 3
Case 2 To 29
A = 30
Case 30 To 59
A = 5
Case 60 To 89
A = 53
Case Is >= 90
A = 2
End Select
With Sheets("SCHEME").Shapes(i).Fill
.ForeColor.SchemeColor = A
.Visible = (A <> 0)
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Private Sub Routes()
Static Passe%
Dim S As Worksheet
Dim R As Range
Dim SH As Shape
Dim i&
Dim A%
'---
If Passe% = 0 Then
Set S = Sheets("Routes1")
Passe% = 1
Else
Set S = Sheets("Routes2")
Passe% = 0
End If
'---
Set R = S.Range("L3")
Application.ScreenUpdating = False
With S
For Each SH In Sheets("SCHEME").Shapes
If Left(SH.Name, 8) = "Straight" Then
i = i + 1
Select Case .Range(R.Address).Offset(i - 1).Value
Case Is <= 1
A = 3
Case 2 To 29
A = 30
Case 30 To 59
A = 5
Case 60 To 89
A = 53
Case Is >= 90
A = 2
End Select
SH.Line.ForeColor.SchemeColor = A
SH.Visible = (A <> 0)
End If
Next SH
End With
Application.ScreenUpdating = True
End Sub