Bonjour à tous,
Dans cet exercice, il faut faire la gestion minutée des feux tricolores en VBA
Feux tricolore.xlsx (12,0 Ko)
Bonjour les gens,
Salut @Mimimathy, 
Voici une proposition arrangée à ma sauce 
on ne se moque pas comme d’hab.
Ce n’ai pas du tout VBA, mais un mixte de formule et de VBA, on fait comme on pneu 
Faire un appuis sur le bouton “Go”, alors le cycle des feux tricolores démarre, j’ai choisi un cycle toutes les 5 secondes afin de ne pas attendre des plombes pour voir son fonctionnement.
Faire un appuis sur le bouton “Stop” alors les 4 feux passent à l’Orange Fixe, j’aurai bien aimer les mettre à l’Orange Clignotant, mais je n’y suis pas parvenu.
Les Macros:
Public Début, Stop1, StopX
Sub Feux_Tricolores()
Range("B1").FormulaR1C1 = "=Feux(R[1]C)" 'Mettre la formule =Feux(B2) dans B1
Range("B3") = "00:00:20" 'Met 20 secondes dans B3
Range("B2") = Range("B3") 'Mettre dans la cellule B2 la valeur de B3
Début = Time 'Début = Retourne l'heure actuelle et fixe la
Stop1 = False
StopX = True
Do While Not Stop1 'Boucle tant que Stop1 est faux
Range("B2") = Range("B3") - (Time - Début) 'B2 = B3-(Heure actuelle-Heure Début)
If Range("B2") <= 0 Then Range("B2") = 0 'Stop1= Vrai
If Range("B2") <= 0 Then Feux_Tricolores 'Stop1 = Faux
'Si B1 = 1 alors D2 = Vert et D3 = Rouge
If Range("B1") = 1 Then
Range("D2").FormulaR1C1 = "=IF(R1C2=1,""n"","" "")"
Range("D3").FormulaR1C1 = "=IF(OR(R1C2=1,R1C2=2),""n"","" "")"
Else 'Sinon
'Si B1 = 2 alors E2 = Orange et D3 = Rouge
If Range("B1") = 2 Then
Range("E2").FormulaR1C1 = "=IF(R1C2=2,""n"","" "")"
Range("D3").FormulaR1C1 = "=IF(OR(R1C2=1,R1C2=2),""n"","" "")"
Else 'Sinon
'Si B1 = 3 alors F2 = Rouge et F3 = Vert
If Range("B1") = 3 Then
Range("F2").FormulaR1C1 = "=IF(OR(R1C2=3,R1C2=4),""n"","" "")"
Range("F3").FormulaR1C1 = "=IF(R1C2=3,""n"","" "")"
Else 'Sinon
'Si B1 = 4 alors F2 = Rouge et E3 = Orange
If Range("B1") = 4 Then
Range("F2").FormulaR1C1 = "=IF(OR(R1C2=3,R1C2=4),""n"","" "")"
Range("E3").FormulaR1C1 = "=IF(R1C2=4,""n"","" "")"
End If
End If
End If
End If
DoEvents
Loop
End Sub
Sub StopFeux()
Stop1 = True 'Stop1= Vrai
StopX = True 'StopX) Vrai
If Stop1 = True And StopX = True Then Range("B1") = 5
'Si Stop1 = Vrai et StopX =Vrai Alors met dans B1 la valeur 5
If Range("B1") = 5 Then 'Si B1 = 5 Alors
Range("D2:F3").ClearContents 'Efface les formules dans la plage D2 a F3
Range("B2") = 0 'Met dans B2 la valeur 00:00:00
Range("B3") = 0 'Met dans B3 la valeur 00:00:00
'Si B1 = 5 Alors E2 et E3 = Orange
Range("E2").FormulaR1C1 = "=IF(R1C2=5,""n"","" "")"
Range("E3").FormulaR1C1 = "=IF(R1C2=5,""n"","" "")"
End If
End Sub
Function Feux(Cel)
'Fonction pour =Feux(B2)
'*************************************************************************
'Cette Fonction remplace la formule
'=SI(B2*3600>=5/8;4;SI(ET(B2*3600>3/7;B2*3600<=5/8);1; _
SI(ET(B2*3600>1/5;B2*3600<=3/7);2;SI(ET(B2*3600>=0;B2*3600<=1/5);3;""))))
'*************************************************************************
Application.Volatile 'Recalcul automatique toutes les 5 secondes
Feux = IIf(Cel * 3600 >= 5 / 8, 4, _
IIf(Cel * 3600 > 3 / 7 And Cel * 3600 <= 5 / 8, 1, _
IIf(Cel * 3600 > 1 / 5 And Cel * 3600 <= 3 / 7, 2, _
IIf(Cel * 3600 >= 0 And Cel * 3600 <= 1 / 5, 3, ""))))
End Function
Le Ficher ICI==> Feux tricolore V1.xlsm (26,1 Ko)
J’attends tes critiques positives et / ou négatives afin de voir comment améliorer tout ça.
@+
PS: @kiss6 au secours, aide moi un peu 
1 « J'aime »
Salut MDO
Bon, une critique positive, cela fonctionne, malgré le Nb d’accident qui va se produirent, si les feux passent aux vert dés que les autres passent au rouge 
Et puis le VBA avec des formules 
Encore un petit effort
Re @Mimimathy,
Merci pour cette critique positive, même si cela peu s’améliorer avec un peu plus de VBA.
Comment ça ! il y a bien une latence avant que les feux passent au vert !
A moins que tu veuilles que chaque rues (les 4) soient indépendantes, ce qui changerai alors le raisonnement que j’ai imaginé de 2 rues indépendantes.
Ce n’était pas précisé dans l’exercice à moins que pour toi la logique était de voir la conditions des 4 stops marqués au sol.
Peux-tu m’en dire plus, afin de corriger au mieux le résultat ?
@+
Re,
Quand les feux passent à l’orange, puis au rouge, il y a un temps avant que les autres passent au vert, pour éviter justement les passage forcées à l’orange et au rouge.
Et les feux sont bien synchro en route verticale et en route horizontale
Par contre tu as eu la bonne idée des feux oranges “clignotant” que j’ai rajouté à ma solution
Re @Mimimathy,
Ok, je vois ce que tu veux dire, je vais donc voir pour ajouter quelques secondes de décalage.
Mais comme dans ma campagne, il n’y a pas de feux tricolores, je n’ais l’habitude 
La bonne excuse n’est-ce pas !
Ça me rassure 
Merci 
Grrr… Si j’avais ton talent
@+
Re,
Cela me fait penser à une chanson:
J’ai la mémoire qui flanche, je me souviens plus très bien … 
Grrr… Si j’avais ton talent
C’est le but des exercices, progresser et dépasser le maître.
Et je peut te dire que tu as l’imagination de certaines choses que je ne vois pas toujours, comme quoi, la complémentarité est souvent bénéfique 
1 « J'aime »
Re,
Bonsoir @Mimimathy , @mdo100
Et bien ils ne vous reste plus que les véhicules avec clignotants et le tour est joué
Vous êtes parti dans un bon délire tous les deux et la je ne peut plus suivre mais je viens espionner quand
même dès que je peut
Pour @mdo100 la classe transformer les formule en VBA 
CDLT
1 « J'aime »
Bonsoir tout le monde les gens,
Salut @Mimimathy, @kiss6,
@Mimimathy, Bon je crois que je suis arrivé à une proposition satisfaisante 
j’espère que tu ne m’enlèveras pas mon beau sourire du soir, même si je sais que ta proposition sera bien différente de la mienne.
Il faudrait que je peaufine encore un peu les réglages sur les temps d’attente du passage du rouge au vert, mais je voulais poster ma version avant que @kiss6 ne poste la sienne
Sur un cycle de 30 secondes:
Les macros dans Thisworkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ArrêtEclairage
End Sub
Private Sub Workbook_Open()
Eclairage
End Sub
Les macros dans le Module1:
Option Explicit
Dim vNow As Variant
Public Sub Eclairage()
vNow = Now + TimeValue("00:00:01")
Application.OnTime vNow, "Eclairage"
ActiveWorkbook.Names.Add Name:="VarEclairage", RefersToR1C1:=1 - [VarEclairage]
End Sub
Public Sub ArrêtEclairage()
On Error Resume Next
Application.OnTime EarliestTime:=vNow, _
Procedure:="Eclairage", Schedule:=False
ActiveWorkbook.Names.Add Name:="VarEclairage", RefersToR1C1:=1
End Sub
Les macros dans le Module2:
Public Début, Stop1, StopX
Sub Feux_Tricolores()
Range("B1").FormulaR1C1 = "=Feux(R[1]C)" 'Mettre la formule =Feux(B2) dans B1
Range("B3") = "00:00:30" 'Met 20 secondes dans B3
Range("B2") = Range("B3") 'Mettre dans la cellule B2 la valeur de B3
Début = Time 'Début = Retourne l'heure actuelle et fixe la
Stop1 = False
StopX = True
Do While Not Stop1 'Boucle tant que Stop1 est faux
Range("B2") = Range("B3") - (Time - Début) 'B2 = B3-(Heure actuelle-Heure Début)
If Range("B2") <= 0 Then Range("B2") = 0 'Stop1= Vrai
If Range("B2") <= 0 Then Feux_Tricolores 'Stop1 = Faux
DoEvents
Loop
End Sub
Sub StopFeux()
Stop1 = True 'Stop1= Vrai
StopX = True 'StopX) Vrai
If Stop1 = True And StopX = True Then Range("B1") = 7
'Si Stop1 = Vrai et StopX =Vrai Alors met dans B1 la valeur 7
Range("B2") = 0 'Met dans B2 la valeur 00:00:00
Range("B3") = 0 'Met dans B3 la valeur 00:00:00
End Sub
Function Feux(Cel) 'Fonction pour =Feux(B2)
Application.Volatile 'Recalcul automatique toutes les 5 secondes
Feux = _
IIf(Cel >= 2.89351851851852E-04 And Cel <= 3.47222222222222E-04, 1, _
IIf(Cel * 3600 > 5 / 6 And Cel <= 2.89351851851852E-04, 2, _
IIf(Cel * 3600 > 5 / 8 And Cel * 3600 <= 5 / 6, 3, _
IIf(Cel * 3600 > 3 / 7 And Cel * 3600 <= 5 / 8, 4, _
IIf(Cel * 3600 > 1 / 5 And Cel * 3600 <= 3 / 7, 5, _
IIf(Cel * 3600 >= 0 And Cel * 3600 < 1 / 5, 6, 1))))))
End Function
Voir aussi les MFCs dans Mise en forme conditionnelle du Ruban de l’onglet Accueil.
Le fichier ICI==> Feux tricolore OK.xlsm (46,9 Ko)
@Mimimathy, j’attends ton verdict pour savoir si je passe par la case prison
@+
Re @Mimimathy,
Il y a un problème ou 2 sur ton fichier.
Quand je l’ouvre et que je clique directement clique sur “Stop”
Puis pendant le cycle, si je clique sur Orange les Feux clignotes bien, mais si je veux reprendre un cycle, ça me ferme le fichier.
Enfin, quand j’ouvre le fichier je ne peux pas faire du Orange clignotant avant d’enclencher un cycle et si je clique sur Orange et que j’enclenche un cycle le fichier se ferme au bout de quelques secondes et me remplie la Corbeille avec des fichier .xlsb.
C’est toi qui vas finir en prison 
@+
Re @Mimimathy,
@Mimimathy, je me suis bien amusé 
avec cet exercice très ludique et formateur, même si parfois je me suis agacé 
de ne pas trouvé plus rapidement.
J’ai fais une pette amélioration de la fonction personnalisée pour une meilleur compréhension.
Function Feux(Cel) 'Fonction pour =Feux(B2)
Application.Volatile 'Recalcul automatique toutes les 5 secondes
Feux = _
IIf(Cel * 60 >= 1 / 58 And Cel * 60 <= 1 / 48, 1, _
IIf(Cel * 60 > 1 / 72 And Cel * 60 <= 1 / 48, 2, _
IIf(Cel * 60 > 1 / 96 And Cel * 60 <= 1 / 72, 3, _
IIf(Cel * 60 > 1 / 144 And Cel * 60 <= 1 / 96, 4, _
IIf(Cel * 60 > 1 / 288 And Cel * 60 <= 1 / 144, 5, _
IIf(Cel >= 0 And Cel * 60 < 1 / 288, 6, 1))))))
End Function
Et à l’ouverture du fichier, Orange clignotant.
Et un p’tit plus que ceux et celles qui seront curieux en téléchargeant mon fichier. 
Le fichier ICI==> Feux tricolore OK V1.xlsm (443,4 Ko)
Bonne soirée.
Salut MDO,
Je regarde ton dernier montage, mais, tu n’avais plus de sou sous pour mettre du carburant dans les voitures 
Salut @Mimimathy,
Oui, ça serai amusant de faire circuler les voitures en fonction de la couleur des feux.
Mais là, ça doit être une autre paire de manche, réservé à une poignée d’expert digne de toi.
Pour ma part, je vais en rester là, je suis même plutôt content de moi d’avoir trouvé une solution digne d’un apprenti VBA
Encore merci de nous faire part de tes connaissances, afin de nous faire progresser, enfin pour ceux et celles qui veulent bien prendre part au petit jeux des Exercices.
Je dis ça, je dis rien…
Bonne journée.
1 « J'aime »