Exercice N°7 - Gestion de feux tricolore


#1

Bonjour à tous,

Dans cet exercice, il faut faire la gestion minutée des feux tricolores en VBA

Feux tricolore.xlsx (12,0 Ko)


#2

Bonjour les gens,
Salut @Mimimathy, :wink:

Voici une proposition arrangée à ma sauce :stuck_out_tongue_winking_eye: 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 :upside_down_face:

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 :face_with_monocle:


#3

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 image

Et puis le VBA avec des formules :woozy_face:

Encore un petit effort :wink:


#4

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 ?

@+


#5

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


#6

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 :weary: La bonne excuse n’est-ce pas !

Ça me rassure :blush:

Merci :white_check_mark:

:triumph: Grrr… Si j’avais ton talent

@+


#7

Re,
Cela me fait penser à une chanson:
J’ai la mémoire qui flanche, je me souviens plus très bien … :grin:

:triumph: 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 :ok_hand:


#8

Re,

Bonsoir @Mimimathy , @mdo100

Et bien ils ne vous reste plus que les véhicules avec clignotants :wink: 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 :+1: :muscle: :clap: :clap::wink:

CDLT

@kiss6


#9

Bonsoir tout le monde les gens,
Salut @Mimimathy, @kiss6, :wink:

@Mimimathy, Bon je crois que je suis arrivé à une proposition satisfaisante :blush: 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 :stuck_out_tongue_winking_eye:

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 :upside_down_face:

@+


#10

Salut MDO

Tu vois quand tu veux, il suffit que je te pousse au C… et tu trouves

Bon, ce n’est pas en pur VBA avec les MFC, mais Chapeau :wink:

Voici mon montage
Le cycle des feux est de 3 tours par une for next, les délais entre orange et rouge sont de 2 sec, 5 sec pour le reste et les oranges clignotant en 0,7 sec

Option Explicit
Dim R1, R2, R3, R4, O1, O2, O3, O4, V1, V2, V3, V4
Dim i As Long, Fin
Sub TempoNonBloquante()
  
  'Attribue une variable aux divers feux pour raccourcir les formules
  Set R1 = Sheets("Feux").Shapes("Rouge1")
  Set R2 = Sheets("Feux").Shapes("Rouge2")
  Set O1 = Sheets("Feux").Shapes("Orange1")
  Set O2 = Sheets("Feux").Shapes("Orange2")
  Set V1 = Sheets("Feux").Shapes("Vert1")
  Set V2 = Sheets("Feux").Shapes("Vert2")
  Set R3 = Sheets("Feux").Shapes("Rouge3")
  Set R4 = Sheets("Feux").Shapes("Rouge4")
  Set O3 = Sheets("Feux").Shapes("Orange3")
  Set O4 = Sheets("Feux").Shapes("Orange4")
  Set V3 = Sheets("Feux").Shapes("Vert3")
  Set V4 = Sheets("Feux").Shapes("Vert4")
  
  For i = 1 To 3 'Boucle 3 fois sur le cycle des feux
  'Feux 1 & 2 au rouge - Feux 3 & 4 au vert
    R1.Visible = True:  R2.Visible = True:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
    V3.Visible = True:  V4.Visible = True: O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
    Sec5
  'Feux 1 & 2 au rouge - Feux 3 & 4 à l'orange
    R1.Visible = True:  R2.Visible = True:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False:  O1.Visible = False:  O2.Visible = False:  O3.Visible = True:  O4.Visible = True
    Sec2
  'Feux 1 & 2 au rouge - Feux 3 & 4 au rouge
    R1.Visible = True:  R2.Visible = True:  R3.Visible = True:  R4.Visible = True:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False:  O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
    Sec2
  'Feux 1 & 2 au vert - Feux 3 & 4 au rouge
    R1.Visible = False:  R2.Visible = False:  R3.Visible = True:  R4.Visible = True:  V1.Visible = True:  V2.Visible = True
    V3.Visible = False:  V4.Visible = False:  O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
    Sec5
  'Feux 1 & 2 à l'orange - Feux 3 & 4 au rouge
    R1.Visible = False:  R2.Visible = False:  R3.Visible = True:  R4.Visible = True:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False:  O1.Visible = True:  O2.Visible = True:  O3.Visible = False:  O4.Visible = False
    Sec2
  'Feux 1 & 2 au rouge - Feux 3 & 4 au rouge
    R1.Visible = True:  R2.Visible = True:  R3.Visible = True:  R4.Visible = True:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False:  O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
    Sec2
  'Feux 1 & 2 au rouge - Feux 3 & 4 au vert
    R1.Visible = True:  R2.Visible = True:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
    V3.Visible = True:  V4.Visible = True:  O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
  Next i
  Arret
End Sub

Sub Sec5() 'Durée d'attente de 5 secondes
  Fin = Timer + 5
    Do While Timer < Fin
      DoEvents
    Loop
End Sub
Sub Sec2() 'Durée d'attente de 2 secondes
  Fin = Timer + 2
    Do While Timer < Fin
      DoEvents
    Loop
End Sub
Sub Sec1() 'Durée d'attente de 0,7 seconde
  Fin = Timer + 0.7
    Do While Timer < Fin
      DoEvents
    Loop
End Sub
Sub Orange() 'Feux orange clignotants
  On Error Resume Next
  For i = 1 To 10000 'boucle 10000 fois
  'Feux éteints
    R1.Visible = False:  R2.Visible = False:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False: O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
    Sec1
  'Feux orange
    R1.Visible = False:  R2.Visible = False:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
    V3.Visible = False:  V4.Visible = False: O1.Visible = True:  O2.Visible = True:  O3.Visible = True:  O4.Visible = True
    Sec1
  Next i
End Sub
Sub Arret()
  'Feux éteints
  R1.Visible = False:  R2.Visible = False:  R3.Visible = False:  R4.Visible = False:  V1.Visible = False:  V2.Visible = False
  V3.Visible = False:  V4.Visible = False: O1.Visible = False:  O2.Visible = False:  O3.Visible = False:  O4.Visible = False
  End
End Sub

Feux tricolore.xlsm (22,6 Ko)


#11

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 :joy:

@+


#12

Re,

Bien, j’avais tous vérifié, petit coquin

Bon, un p’tit tour de deux ou trois lignes et cela devrait te rassurer pour être quitte de m’apporter des oranges:woozy_face:

Feux tricolore.xlsm (23,4 Ko)


#13

Re @Mimimathy,

@Mimimathy, je me suis bien amusé :partying_face: avec cet exercice très ludique et formateur, même si parfois je me suis agacé :face_with_symbols_over_mouth: 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. :heart_eyes:

Le fichier ICI==> Feux tricolore OK V1.xlsm (443,4 Ko)

Bonne soirée.


#14

Salut MDO,

Je regarde ton dernier montage, mais, tu n’avais plus de sou sous pour mettre du carburant dans les voitures :joy:


#15

Salut @Mimimathy, :wink:

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 :blush:

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.