Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Code VBA pour Arrêt macro avec un bouton

Code VBA pour Arrêt macro avec un bouton

14 réponses
Avatar
DC
Bonjour à tous,..................Excel 2000 sous XP

Merci de me lire................Bonne Journée...!!

Voilà, je dispose d'une procédure qui tourne en boucle et qui fonctionne
avec un bouton marche et un bouton arrêt, mon petit problème est dans la
macro arrêt, ci-dessous,
'---------------------------------------------------------
Sub Test_Arret()
'
ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "{Ctrl,Pause}"
SendKeys "{F}"

End Sub
'--------------------------------------------------------
C'est le [ SendKeys"{F}" ] qui ne veut rien savoir, si je le fait
manuellement au clavier, la fenêtre VB disparait, je suppose que le
( Ctrl,Pause ) à mis la macro en pause, et l'ordre suivant n'est pas pris en
compte, mais est-ce qu'il y à une astuce pour remédier à cet
inconvénient...............Merci d'y penser...!!

Cordialement.....Merci d'avance.....Joyeuses Fêtes...!!......DC
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
LSteph
Re,
voici rectifié et adapté le délai
(pour plus d'options de timing
remplacer le if then else par un select case

http://cjoint.com/?mFpxK6fmdD

Pour faire un commandbutton1 dont on peut
modifier les propriétés en vba il faut le prendre dans la BO VB et non
Formulaire

Bonne fin d'année.

;o)

lSteph

"DC" a écrit dans le message de news:
43b6856a$0$6648$
Re-bonjour LSteph................Merci de t'es explications positives,

http://cjoint.com/?mFoePuxdpY

Je crois cette fois-ci, avoir réussi, çà paraît plus facile que la
première fois, grace à t'es conseils..........Merci...!!

Cordialement......Bon réveillon......et Bonne fin d'Année...!!...DC

"LSteph" a écrit dans le message de news:

Re,
Je t'ais envoyé le fichier complet
Il y a taille limite à ne pas dépasser (auquel cas bal perso)


...s'il n'est pas trosgros
sur http://www.cjoint.com tu indiques ton fichier avec
parcourir
clic sur créer le lien et tu obtiens un lien indiqué sur l'écran
et copié dans ton pressepapier
il faut venir coller ce lien ici dans un message
lSteph

"DC" a écrit dans le message de news:
43b65a75$0$6649$
Bonjour à tous................Joyeuse Fin d'Année et vive 2006...!!

Bonjour LSteph.........Merci de me répondre, malgrès cette chose sur le
feux,

Je t'ais envoyé le fichier complet sur http://www.cjoint.com
il se nomme "Feux tricolores" et j'espére avoir bien fait les choses,
mais çà reste à prouver, car j'ai un peu hésité dans la manoeuvre et ne
suis pas très sûr, du résultat, tu me tiens au courant ....Merci...!!

Cordialement.....Très Bonne Fin d'Année......un grand Merci...!!
.............DC










"LSteph" a écrit dans le message de news:

Re,
si tu le souhaite..va là http://www.cjoint.com poser ton fichier
et remets un lien ici j'y verrais directement plus clair.
ou si préfères en bal perso
cocosteph (cequivazaumilieu) free.fr

'lSteph


"DC" a écrit dans le message de news:
43b567e9$0$6641$
Bonsoir à tous,...........................Bonsoir LSteph,

Merci de ta réponse................Bonne fin d'année...!!

Je me suis enfin décidé à m'investir, dans ta procédure sur les feux
tricolores, effectivement après mult réflexions, rien à voir avec mon
bricolage; elle ressemble à une véritable procédure et elle fonctionne
très très bien,...... juste une petite chose, il faudrait y ajouter la
posibilité d'avoir 2 temporisations, ( 3 s ) pour les fonctions ( 1 +
2 + 4 + 5 ) et ( 10 s ) pour ( 3 + 6 ), histoire de faire la
différence entre l'orange et le vert et rouge

Voici les 6 cellules ( nommées ) et commandées par ta procédure (
123456 ), suivant qu'elles affichent ( 0 ou 1 ) elles agissent sur
d'autres cellules en MEFC ( allant jusqu'a 3 conditions de couleurs )
et disposées en feux de carrefour
'------------------------------------------------------
Noms des
Cellules
rouge 0 10 S Rouge + Vert = 6
rouge_2bis 0 3 S Rouge + Rouge = 5
orange 0 3 S Orange + Rouge = 4
vert 0 10 S Vert + Rouge = 3
rouge_1bis 0 3 S Rouge + Rouge = 2
orange_bis 0 3 S Rouge + Orange = 1

'-----------------------------------------------------
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-4, 0)) = 0
For I = 0 To 5
.Offset(-I, 0).Value = 1
couleur 3
.Offset(-I, 0).Value = 0
Next
End With
Application.OnTime Now + Second(temps), "playlights"
End Sub
'-----------------------------------------------------------
Sub couleur(temps)
Dim S As Double
S = Timer + 5
While Timer < S
DoEvents
Wend
End Sub
'------------------------------------------------
La procédure d'arrêt doit certainemment être mise comme code feuille,
mais je ne sais pas comment lui affecter un bouton,
'-------------------------------------------------
Private Sub CommandButton1_Click()
With commandbutton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'-------------------------------------------------
Cordialement...........Merci d'avance........Joyeuses Fêtes........DC

"LSteph" a écrit dans le message de news:
%
Bonsoir,
(Je suggérais f au lieu de F)
Il me semblait avoir écrit un truc semblable il y a peu et qui en
plus marchait mais bon...

Pour arrêter tout c'est End

exemple avec un bouton pour arrêter ou lancer la macro ici
"playlights":
'*****
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"
playlights

End If
End With
End Sub
'*******
'lSteph
"DC" a écrit dans le message de news:
43b40f76$0$19720$
Bonsoir à tous.............................Bonsoir LSteph,

Merci de ta réponse.....................Joyeuses Fêtes...!!

Je vais essayer d'ètre clair,......( à savoir que c'est un amusement
instructif...!! ), ...................rien de plus..................

Avec Excel j'ai implanté un carrefour routier, donc un croisement
avec 4 feux et 6 situations possibles,
1) N/S = 3 s = rouge.................E/O = orange
2) N/S = 3 s = rouge.................E/O = rouge
3) N/S = 10 s = vert..................E/O = rouge
4) N/S = 3 s = orange...............E/O = rouge
5) N/S = 3 s = rouge.................E/O = rouge
6) N/S = 10 s = rouge...............E/O = vert
A chaque coin du carrefour = 3 cellules MEFC ( image des feux )
ces cellules sont gérées par 5 cellules commandes ( 0 = rien ) et
( 1 = couleurs )........et le tout géré par la procédure ci-dessous,
'****************************************
Sub Feux_Rouge()
On Error GoTo Sortie
'--------------------------------------------
Application.Goto Reference:="orange_bis"
With Range("orange_bis")
End With
'--------------------------------------------
ActiveCell.FormulaR1C1 = "1"
Dim S As Double
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-----------------------------------------------
ActiveCell.Offset(-4, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'------------------------------------------------
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(-2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
Application.Run "'Feux tricolores.xls'!Feux_Rouge"

Sortie:
End Sub
'******************************************
Il me reste donc 1 autre macro, affectée au bouton Arrêt,
elle fonctionne très bien, le seul petit inconvénient d'esthétique,
est dans cette macro arrêt, avec l'apparition d'une fenêtre VB que
je fais disparaitre manuellement, avec la lettre F de Fin,.....et ce
que je veux faire,....... et bien, c'est d'éviter l'apparition de
cette fenêtre, ou qu'elle disparaisse, avec la procédure de la macro
Arrêt, ...........c'est dire la difficulté, inutile de la chose,
n'est-ce pas...!!

Merci d'avance...!!...............j'espére avoir été clair, mais
bon...!!

Voici la macro Arrêt, ( modifiée, mais même résultat )
'*********************************
Sub Test_Arret()

ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "^{Break}", 1
SendKeys "{F,f"}"

End Sub
'***************************************

Cordialement.........Merci beaucoups........bonne soirée...!!...DC

"LSteph" a écrit dans le message de news:
%
Bonjour DC,

déjà ceci
SendKeys "{Ctrl,Pause}"
ne va pas

SendKeys "^{Break}", 1

sinon
F , f"
et surtout
Que veux tu faire ?

lSteph


"DC" a écrit dans le message de news:
43b3c4f2$0$18325$
Bonjour à tous,..................Excel 2000 sous XP

Merci de me lire................Bonne Journée...!!

Voilà, je dispose d'une procédure qui tourne en boucle et qui
fonctionne avec un bouton marche et un bouton arrêt, mon petit
problème est dans la macro arrêt, ci-dessous,
'---------------------------------------------------------
Sub Test_Arret()
'
ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "{Ctrl,Pause}"
SendKeys "{F}"

End Sub
'--------------------------------------------------------
C'est le [ SendKeys"{F}" ] qui ne veut rien savoir, si je le fait
manuellement au clavier, la fenêtre VB disparait, je suppose que
le
( Ctrl,Pause ) à mis la macro en pause, et l'ordre suivant n'est
pas pris en compte, mais est-ce qu'il y à une astuce pour remédier
à cet inconvénient...............Merci d'y penser...!!

Cordialement.....Merci d'avance.....Joyeuses Fêtes...!!......DC



































Avatar
LSteph
Bonsoir,
avec un pti +
http://cjoint.com/?bcaMraYDeO

'****dans code Feuil1
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'****Module feux(standard)
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-5, 0)) = 0
For i = 0 To 5
.Offset(-i, 0).Value = 1
If i = 4 Or i = 1 Then
couleur 2
Else
If i = 2 Or i = 5 Then aTrafic (i)
couleur 5


End If
.Offset(-i, 0).Value = 0

Next
End With
Application.OnTime Now + TimeValue("00:00:0" & temps), "playlights"
End Sub

Sub couleur(temps)
Dim S As Double
S = Timer + temps
While Timer < S
DoEvents
Wend
End Sub
'******Module Mvoitures(standard)
Public Tmouv As Boolean
Public num As Integer

Public Sub aTrafic(n As Integer)
num = n
mouvoiture
End Sub



Sub mouvoiture()

Select Case num
Case 2
mouvoiturA

Case 5
mouvoiturB

End Select

Application.OnTime Now + TimeValue("00:00:01"), "remetvoiture"
End Sub

Sub remetvoiture()
Dim dest1 As String, dest2 As String
Dim grp1 As String, grp2 As String
Tmouv = Not Tmouv
Select Case num
Case 2
dest1 = "p20"
dest2 = "m1"
grp1 = "Voiture1"
grp2 = "Voiture2"
Case 5
dest1 = "k14"
dest2 = "r9"
grp1 = "Voiture3"
grp2 = "Voiture4"
End Select
With ActiveSheet
.Shapes(grp1).Cut
.Paste Range(dest1)
.Shapes(grp2).Cut
.Paste Range(dest2)
End With
If Tmouv Then
Application.OnTime Now + TimeValue("00:00:01"), "mouvoiture"
End If
End Sub
Sub testshapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Select
MsgBox sh.Name
Next
End Sub

Sub mouvoiturA()

For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture1")
.Top = .Top - (i / 1000)
End With
With ActiveSheet.Shapes("Voiture2")
.Top = .Top + (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub

Sub mouvoiturB()



For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture3")
.Left = .Left + (i / 1000)
End With
With ActiveSheet.Shapes("Voiture4")
.Left = .Left - (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub
'**************************************
'lSteph





"LSteph" a écrit dans le message de news:

Re,
voici rectifié et adapté le délai
(pour plus d'options de timing
remplacer le if then else par un select case

http://cjoint.com/?mFpxK6fmdD

Pour faire un commandbutton1 dont on peut
modifier les propriétés en vba il faut le prendre dans la BO VB et non
Formulaire

Bonne fin d'année.

;o)

lSteph

"DC" a écrit dans le message de news:
43b6856a$0$6648$
Re-bonjour LSteph................Merci de t'es explications positives,

http://cjoint.com/?mFoePuxdpY

Je crois cette fois-ci, avoir réussi, çà paraît plus facile que la
première fois, grace à t'es conseils..........Merci...!!

Cordialement......Bon réveillon......et Bonne fin d'Année...!!...DC

"LSteph" a écrit dans le message de news:

Re,
Je t'ais envoyé le fichier complet
Il y a taille limite à ne pas dépasser (auquel cas bal perso)


...s'il n'est pas trosgros
sur http://www.cjoint.com tu indiques ton fichier avec
parcourir
clic sur créer le lien et tu obtiens un lien indiqué sur l'écran
et copié dans ton pressepapier
il faut venir coller ce lien ici dans un message
lSteph

"DC" a écrit dans le message de news:
43b65a75$0$6649$
Bonjour à tous................Joyeuse Fin d'Année et vive 2006...!!

Bonjour LSteph.........Merci de me répondre, malgrès cette chose sur le
feux,

Je t'ais envoyé le fichier complet sur http://www.cjoint.com
il se nomme "Feux tricolores" et j'espére avoir bien fait les choses,
mais çà reste à prouver, car j'ai un peu hésité dans la manoeuvre et ne
suis pas très sûr, du résultat, tu me tiens au courant ....Merci...!!

Cordialement.....Très Bonne Fin d'Année......un grand Merci...!!
.............DC










"LSteph" a écrit dans le message de news:

Re,
si tu le souhaite..va là http://www.cjoint.com poser ton fichier
et remets un lien ici j'y verrais directement plus clair.
ou si préfères en bal perso
cocosteph (cequivazaumilieu) free.fr

'lSteph


"DC" a écrit dans le message de news:
43b567e9$0$6641$
Bonsoir à tous,...........................Bonsoir LSteph,

Merci de ta réponse................Bonne fin d'année...!!

Je me suis enfin décidé à m'investir, dans ta procédure sur les feux
tricolores, effectivement après mult réflexions, rien à voir avec mon
bricolage; elle ressemble à une véritable procédure et elle
fonctionne très très bien,...... juste une petite chose, il faudrait
y ajouter la posibilité d'avoir 2 temporisations, ( 3 s ) pour les
fonctions ( 1 + 2 + 4 + 5 ) et ( 10 s ) pour ( 3 + 6 ), histoire de
faire la différence entre l'orange et le vert et rouge

Voici les 6 cellules ( nommées ) et commandées par ta procédure (
123456 ), suivant qu'elles affichent ( 0 ou 1 ) elles agissent sur
d'autres cellules en MEFC ( allant jusqu'a 3 conditions de couleurs )
et disposées en feux de carrefour
'------------------------------------------------------
Noms des
Cellules
rouge 0 10 S Rouge + Vert = 6
rouge_2bis 0 3 S Rouge + Rouge = 5
orange 0 3 S Orange + Rouge = 4
vert 0 10 S Vert + Rouge = 3
rouge_1bis 0 3 S Rouge + Rouge = 2
orange_bis 0 3 S Rouge + Orange = 1

'-----------------------------------------------------
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-4, 0)) = 0
For I = 0 To 5
.Offset(-I, 0).Value = 1
couleur 3
.Offset(-I, 0).Value = 0
Next
End With
Application.OnTime Now + Second(temps), "playlights"
End Sub
'-----------------------------------------------------------
Sub couleur(temps)
Dim S As Double
S = Timer + 5
While Timer < S
DoEvents
Wend
End Sub
'------------------------------------------------
La procédure d'arrêt doit certainemment être mise comme code feuille,
mais je ne sais pas comment lui affecter un bouton,
'-------------------------------------------------
Private Sub CommandButton1_Click()
With commandbutton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'-------------------------------------------------
Cordialement...........Merci d'avance........Joyeuses Fêtes........DC

"LSteph" a écrit dans le message de news:
%
Bonsoir,
(Je suggérais f au lieu de F)
Il me semblait avoir écrit un truc semblable il y a peu et qui en
plus marchait mais bon...

Pour arrêter tout c'est End

exemple avec un bouton pour arrêter ou lancer la macro ici
"playlights":
'*****
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"
playlights

End If
End With
End Sub
'*******
'lSteph
"DC" a écrit dans le message de news:
43b40f76$0$19720$
Bonsoir à tous.............................Bonsoir LSteph,

Merci de ta réponse.....................Joyeuses Fêtes...!!

Je vais essayer d'ètre clair,......( à savoir que c'est un
amusement instructif...!! ), ...................rien de
plus..................

Avec Excel j'ai implanté un carrefour routier, donc un croisement
avec 4 feux et 6 situations possibles,
1) N/S = 3 s = rouge.................E/O = orange
2) N/S = 3 s = rouge.................E/O = rouge
3) N/S = 10 s = vert..................E/O = rouge
4) N/S = 3 s = orange...............E/O = rouge
5) N/S = 3 s = rouge.................E/O = rouge
6) N/S = 10 s = rouge...............E/O = vert
A chaque coin du carrefour = 3 cellules MEFC ( image des feux )
ces cellules sont gérées par 5 cellules commandes ( 0 = rien ) et
( 1 = couleurs )........et le tout géré par la procédure
ci-dessous,
'****************************************
Sub Feux_Rouge()
On Error GoTo Sortie
'--------------------------------------------
Application.Goto Reference:="orange_bis"
With Range("orange_bis")
End With
'--------------------------------------------
ActiveCell.FormulaR1C1 = "1"
Dim S As Double
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-----------------------------------------------
ActiveCell.Offset(-4, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'------------------------------------------------
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(-2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
Application.Run "'Feux tricolores.xls'!Feux_Rouge"

Sortie:
End Sub
'******************************************
Il me reste donc 1 autre macro, affectée au bouton Arrêt,
elle fonctionne très bien, le seul petit inconvénient d'esthétique,
est dans cette macro arrêt, avec l'apparition d'une fenêtre VB que
je fais disparaitre manuellement, avec la lettre F de Fin,.....et
ce que je veux faire,....... et bien, c'est d'éviter l'apparition
de cette fenêtre, ou qu'elle disparaisse, avec la procédure de la
macro Arrêt, ...........c'est dire la difficulté, inutile de la
chose, n'est-ce pas...!!

Merci d'avance...!!...............j'espére avoir été clair, mais
bon...!!

Voici la macro Arrêt, ( modifiée, mais même résultat )
'*********************************
Sub Test_Arret()

ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "^{Break}", 1
SendKeys "{F,f"}"

End Sub
'***************************************

Cordialement.........Merci beaucoups........bonne soirée...!!...DC

"LSteph" a écrit dans le message de news:
%
Bonjour DC,

déjà ceci
SendKeys "{Ctrl,Pause}"
ne va pas

SendKeys "^{Break}", 1

sinon
F , f"
et surtout
Que veux tu faire ?

lSteph


"DC" a écrit dans le message de news:
43b3c4f2$0$18325$
Bonjour à tous,..................Excel 2000 sous XP

Merci de me lire................Bonne Journée...!!

Voilà, je dispose d'une procédure qui tourne en boucle et qui
fonctionne avec un bouton marche et un bouton arrêt, mon petit
problème est dans la macro arrêt, ci-dessous,
'---------------------------------------------------------
Sub Test_Arret()
'
ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "{Ctrl,Pause}"
SendKeys "{F}"

End Sub
'--------------------------------------------------------
C'est le [ SendKeys"{F}" ] qui ne veut rien savoir, si je le fait
manuellement au clavier, la fenêtre VB disparait, je suppose que
le
( Ctrl,Pause ) à mis la macro en pause, et l'ordre suivant n'est
pas pris en compte, mais est-ce qu'il y à une astuce pour
remédier à cet inconvénient...............Merci d'y penser...!!

Cordialement.....Merci d'avance.....Joyeuses Fêtes...!!......DC







































Avatar
DC
Meilleurs Voeux de Bonheur et de Santé, à Toutes et Tous...!!

Bonjour LStehp,....Quel plus...!!....incroyable; un vrais cadeau de fin
d'année, le déplacement des voitures synchro. avec les feux, franchement,
j'aprécie et je ne pensais pas que celà puisse ce faire avec un tableur,
"CHAPEAU" ( Monsieur le Débutant Confirmé ), je ne sais plus quoi dire,
sinon que j'ai l'impression, que le jeux t'as un peut pris au piège et çà me
fait plaisir..........un très...très...grand
Merci........!!...............et Bonne et Heureuse Année...!!

Cordialement..............Merci Beaucoups...!!..............DC
"LSteph" a écrit dans le message de news:

Bonsoir,
avec un pti +
http://cjoint.com/?bcaMraYDeO

'****dans code Feuil1
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'****Module feux(standard)
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-5, 0)) = 0
For i = 0 To 5
.Offset(-i, 0).Value = 1
If i = 4 Or i = 1 Then
couleur 2
Else
If i = 2 Or i = 5 Then aTrafic (i)
couleur 5


End If
.Offset(-i, 0).Value = 0

Next
End With
Application.OnTime Now + TimeValue("00:00:0" & temps), "playlights"
End Sub

Sub couleur(temps)
Dim S As Double
S = Timer + temps
While Timer < S
DoEvents
Wend
End Sub
'******Module Mvoitures(standard)
Public Tmouv As Boolean
Public num As Integer

Public Sub aTrafic(n As Integer)
num = n
mouvoiture
End Sub



Sub mouvoiture()

Select Case num
Case 2
mouvoiturA

Case 5
mouvoiturB

End Select

Application.OnTime Now + TimeValue("00:00:01"), "remetvoiture"
End Sub

Sub remetvoiture()
Dim dest1 As String, dest2 As String
Dim grp1 As String, grp2 As String
Tmouv = Not Tmouv
Select Case num
Case 2
dest1 = "p20"
dest2 = "m1"
grp1 = "Voiture1"
grp2 = "Voiture2"
Case 5
dest1 = "k14"
dest2 = "r9"
grp1 = "Voiture3"
grp2 = "Voiture4"
End Select
With ActiveSheet
.Shapes(grp1).Cut
.Paste Range(dest1)
.Shapes(grp2).Cut
.Paste Range(dest2)
End With
If Tmouv Then
Application.OnTime Now + TimeValue("00:00:01"), "mouvoiture"
End If
End Sub
Sub testshapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Select
MsgBox sh.Name
Next
End Sub

Sub mouvoiturA()

For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture1")
.Top = .Top - (i / 1000)
End With
With ActiveSheet.Shapes("Voiture2")
.Top = .Top + (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub

Sub mouvoiturB()



For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture3")
.Left = .Left + (i / 1000)
End With
With ActiveSheet.Shapes("Voiture4")
.Left = .Left - (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub
'**************************************
'lSteph





"LSteph" a écrit dans le message de news:

Re,
voici rectifié et adapté le délai
(pour plus d'options de timing
remplacer le if then else par un select case

http://cjoint.com/?mFpxK6fmdD

Pour faire un commandbutton1 dont on peut
modifier les propriétés en vba il faut le prendre dans la BO VB et non
Formulaire

Bonne fin d'année.

;o)

lSteph

"DC" a écrit dans le message de news:
43b6856a$0$6648$
Re-bonjour LSteph................Merci de t'es explications positives,

http://cjoint.com/?mFoePuxdpY

Je crois cette fois-ci, avoir réussi, çà paraît plus facile que la
première fois, grace à t'es conseils..........Merci...!!

Cordialement......Bon réveillon......et Bonne fin d'Année...!!...DC

"LSteph" a écrit dans le message de news:

Re,
Je t'ais envoyé le fichier complet
Il y a taille limite à ne pas dépasser (auquel cas bal perso)


...s'il n'est pas trosgros
sur http://www.cjoint.com tu indiques ton fichier avec
parcourir
clic sur créer le lien et tu obtiens un lien indiqué sur l'écran
et copié dans ton pressepapier
il faut venir coller ce lien ici dans un message
lSteph

"DC" a écrit dans le message de news:
43b65a75$0$6649$
Bonjour à tous................Joyeuse Fin d'Année et vive 2006...!!

Bonjour LSteph.........Merci de me répondre, malgrès cette chose sur
le feux,

Je t'ais envoyé le fichier complet sur http://www.cjoint.com
il se nomme "Feux tricolores" et j'espére avoir bien fait les choses,
mais çà reste à prouver, car j'ai un peu hésité dans la manoeuvre et
ne suis pas très sûr, du résultat, tu me tiens au courant
....Merci...!!

Cordialement.....Très Bonne Fin d'Année......un grand Merci...!!
.............DC










"LSteph" a écrit dans le message de news:

Re,
si tu le souhaite..va là http://www.cjoint.com poser ton fichier
et remets un lien ici j'y verrais directement plus clair.
ou si préfères en bal perso
cocosteph (cequivazaumilieu) free.fr

'lSteph


"DC" a écrit dans le message de news:
43b567e9$0$6641$
Bonsoir à tous,...........................Bonsoir LSteph,

Merci de ta réponse................Bonne fin d'année...!!

Je me suis enfin décidé à m'investir, dans ta procédure sur les feux
tricolores, effectivement après mult réflexions, rien à voir avec
mon bricolage; elle ressemble à une véritable procédure et elle
fonctionne très très bien,...... juste une petite chose, il faudrait
y ajouter la posibilité d'avoir 2 temporisations, ( 3 s ) pour les
fonctions ( 1 + 2 + 4 + 5 ) et ( 10 s ) pour ( 3 + 6 ), histoire de
faire la différence entre l'orange et le vert et rouge

Voici les 6 cellules ( nommées ) et commandées par ta procédure (
123456 ), suivant qu'elles affichent ( 0 ou 1 ) elles agissent
sur d'autres cellules en MEFC ( allant jusqu'a 3 conditions de
couleurs ) et disposées en feux de carrefour
'------------------------------------------------------
Noms des
Cellules
rouge 0 10 S Rouge + Vert = 6
rouge_2bis 0 3 S Rouge + Rouge = 5
orange 0 3 S Orange + Rouge = 4
vert 0 10 S Vert + Rouge = 3
rouge_1bis 0 3 S Rouge + Rouge = 2
orange_bis 0 3 S Rouge + Orange = 1

'-----------------------------------------------------
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-4, 0)) = 0
For I = 0 To 5
.Offset(-I, 0).Value = 1
couleur 3
.Offset(-I, 0).Value = 0
Next
End With
Application.OnTime Now + Second(temps), "playlights"
End Sub
'-----------------------------------------------------------
Sub couleur(temps)
Dim S As Double
S = Timer + 5
While Timer < S
DoEvents
Wend
End Sub
'------------------------------------------------
La procédure d'arrêt doit certainemment être mise comme code
feuille, mais je ne sais pas comment lui affecter un bouton,
'-------------------------------------------------
Private Sub CommandButton1_Click()
With commandbutton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'-------------------------------------------------
Cordialement...........Merci d'avance........Joyeuses
Fêtes........DC

"LSteph" a écrit dans le message de news:
%
Bonsoir,
(Je suggérais f au lieu de F)
Il me semblait avoir écrit un truc semblable il y a peu et qui en
plus marchait mais bon...

Pour arrêter tout c'est End

exemple avec un bouton pour arrêter ou lancer la macro ici
"playlights":
'*****
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"
playlights

End If
End With
End Sub
'*******
'lSteph
"DC" a écrit dans le message de news:
43b40f76$0$19720$
Bonsoir à tous.............................Bonsoir LSteph,

Merci de ta réponse.....................Joyeuses Fêtes...!!

Je vais essayer d'ètre clair,......( à savoir que c'est un
amusement instructif...!! ), ...................rien de
plus..................

Avec Excel j'ai implanté un carrefour routier, donc un croisement
avec 4 feux et 6 situations possibles,
1) N/S = 3 s = rouge.................E/O = orange
2) N/S = 3 s = rouge.................E/O = rouge
3) N/S = 10 s = vert..................E/O = rouge
4) N/S = 3 s = orange...............E/O = rouge
5) N/S = 3 s = rouge.................E/O = rouge
6) N/S = 10 s = rouge...............E/O = vert
A chaque coin du carrefour = 3 cellules MEFC ( image des feux )
ces cellules sont gérées par 5 cellules commandes ( 0 = rien ) et
( 1 = couleurs )........et le tout géré par la procédure
ci-dessous,
'****************************************
Sub Feux_Rouge()
On Error GoTo Sortie
'--------------------------------------------
Application.Goto Reference:="orange_bis"
With Range("orange_bis")
End With
'--------------------------------------------
ActiveCell.FormulaR1C1 = "1"
Dim S As Double
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-----------------------------------------------
ActiveCell.Offset(-4, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'------------------------------------------------
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(-2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
Application.Run "'Feux tricolores.xls'!Feux_Rouge"

Sortie:
End Sub
'******************************************
Il me reste donc 1 autre macro, affectée au bouton Arrêt,
elle fonctionne très bien, le seul petit inconvénient
d'esthétique, est dans cette macro arrêt, avec l'apparition d'une
fenêtre VB que je fais disparaitre manuellement, avec la lettre F
de Fin,.....et ce que je veux faire,....... et bien, c'est
d'éviter l'apparition de cette fenêtre, ou qu'elle disparaisse,
avec la procédure de la macro Arrêt, ...........c'est dire la
difficulté, inutile de la chose, n'est-ce pas...!!

Merci d'avance...!!...............j'espére avoir été clair, mais
bon...!!

Voici la macro Arrêt, ( modifiée, mais même résultat )
'*********************************
Sub Test_Arret()

ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "^{Break}", 1
SendKeys "{F,f"}"

End Sub
'***************************************

Cordialement.........Merci beaucoups........bonne soirée...!!...DC

"LSteph" a écrit dans le message de news:
%
Bonjour DC,

déjà ceci
SendKeys "{Ctrl,Pause}"
ne va pas

SendKeys "^{Break}", 1

sinon
F , f"
et surtout
Que veux tu faire ?

lSteph


"DC" a écrit dans le message de news:
43b3c4f2$0$18325$
Bonjour à tous,..................Excel 2000 sous XP

Merci de me lire................Bonne Journée...!!

Voilà, je dispose d'une procédure qui tourne en boucle et qui
fonctionne avec un bouton marche et un bouton arrêt, mon petit
problème est dans la macro arrêt, ci-dessous,
'---------------------------------------------------------
Sub Test_Arret()
'
ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "{Ctrl,Pause}"
SendKeys "{F}"

End Sub
'--------------------------------------------------------
C'est le [ SendKeys"{F}" ] qui ne veut rien savoir, si je le
fait manuellement au clavier, la fenêtre VB disparait, je
suppose que le
( Ctrl,Pause ) à mis la macro en pause, et l'ordre suivant n'est
pas pris en compte, mais est-ce qu'il y à une astuce pour
remédier à cet inconvénient...............Merci d'y penser...!!

Cordialement.....Merci d'avance.....Joyeuses Fêtes...!!......DC











































Avatar
LSteph
Bonsoir DC, et itou(s)

Pas vraiment synchro pil poil, chez moi oui, mais tout dépend sans doute de
exécution de la boucle et du diviseur de i
selon la vitesse du processeur à afficher en même temps la statusbar (à
propos j'ai oublié de la remettre à False)
En fait cela reste ainsi à adapter , il y a juste l'idée!
Le jeu ne m'a pas vraiment pris au piège, j'y ai plongé tout droit parceque
c'est un truc du genre totalement inutile mais
qui a le mérite de pouvoir y réfléchir et savoir comment faire le jour où
cela servira à quelquechose, bref merci à toi
de proposer ce genre de trucs bien amusants et propices à quelques
excelliennes ou plutôt vbatesques cogitations...


'lSteph (Meilleurs voeux)

(Dommage que quelque GranD chêne abritant en ces bois Modestement qq
champignon encore en train de grandir n'ait
point encore sur ces quelques charmilles tenté de faire évoluer une jeune
coupe juste taillée en une plus fructueuse futaie.)

"DC" a écrit dans le message de news:
43b906f4$0$21284$
Meilleurs Voeux de Bonheur et de Santé, à Toutes et Tous...!!

Bonjour LStehp,....Quel plus...!!....incroyable; un vrais cadeau de fin
d'année, le déplacement des voitures synchro. avec les feux, franchement,
j'aprécie et je ne pensais pas que celà puisse ce faire avec un tableur,
"CHAPEAU" ( Monsieur le Débutant Confirmé ), je ne sais plus quoi dire,
sinon que j'ai l'impression, que le jeux t'as un peut pris au piège et çà
me fait plaisir..........un très...très...grand
Merci........!!...............et Bonne et Heureuse Année...!!

Cordialement..............Merci Beaucoups...!!..............DC
"LSteph" a écrit dans le message de news:

Bonsoir,
avec un pti +
http://cjoint.com/?bcaMraYDeO

'****dans code Feuil1
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'****Module feux(standard)
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-5, 0)) = 0
For i = 0 To 5
.Offset(-i, 0).Value = 1
If i = 4 Or i = 1 Then
couleur 2
Else
If i = 2 Or i = 5 Then aTrafic (i)
couleur 5


End If
.Offset(-i, 0).Value = 0

Next
End With
Application.OnTime Now + TimeValue("00:00:0" & temps), "playlights"
End Sub

Sub couleur(temps)
Dim S As Double
S = Timer + temps
While Timer < S
DoEvents
Wend
End Sub
'******Module Mvoitures(standard)
Public Tmouv As Boolean
Public num As Integer

Public Sub aTrafic(n As Integer)
num = n
mouvoiture
End Sub



Sub mouvoiture()

Select Case num
Case 2
mouvoiturA

Case 5
mouvoiturB

End Select

Application.OnTime Now + TimeValue("00:00:01"), "remetvoiture"
End Sub

Sub remetvoiture()
Dim dest1 As String, dest2 As String
Dim grp1 As String, grp2 As String
Tmouv = Not Tmouv
Select Case num
Case 2
dest1 = "p20"
dest2 = "m1"
grp1 = "Voiture1"
grp2 = "Voiture2"
Case 5
dest1 = "k14"
dest2 = "r9"
grp1 = "Voiture3"
grp2 = "Voiture4"
End Select
With ActiveSheet
.Shapes(grp1).Cut
.Paste Range(dest1)
.Shapes(grp2).Cut
.Paste Range(dest2)
End With
If Tmouv Then
Application.OnTime Now + TimeValue("00:00:01"), "mouvoiture"
End If
End Sub
Sub testshapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Select
MsgBox sh.Name
Next
End Sub

Sub mouvoiturA()

For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture1")
.Top = .Top - (i / 1000)
End With
With ActiveSheet.Shapes("Voiture2")
.Top = .Top + (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub

Sub mouvoiturB()



For i = 1 To 12000
If i Mod 300 = 0 Then
DoEvents
With ActiveSheet.Shapes("Voiture3")
.Left = .Left + (i / 1000)
End With
With ActiveSheet.Shapes("Voiture4")
.Left = .Left - (i / 1000)
End With
End If
Application.StatusBar = i
Next

End Sub
'**************************************
'lSteph





"LSteph" a écrit dans le message de news:

Re,
voici rectifié et adapté le délai
(pour plus d'options de timing
remplacer le if then else par un select case

http://cjoint.com/?mFpxK6fmdD

Pour faire un commandbutton1 dont on peut
modifier les propriétés en vba il faut le prendre dans la BO VB et non
Formulaire

Bonne fin d'année.

;o)

lSteph

"DC" a écrit dans le message de news:
43b6856a$0$6648$
Re-bonjour LSteph................Merci de t'es explications positives,

http://cjoint.com/?mFoePuxdpY

Je crois cette fois-ci, avoir réussi, çà paraît plus facile que la
première fois, grace à t'es conseils..........Merci...!!

Cordialement......Bon réveillon......et Bonne fin d'Année...!!...DC

"LSteph" a écrit dans le message de news:

Re,
Je t'ais envoyé le fichier complet
Il y a taille limite à ne pas dépasser (auquel cas bal perso)


...s'il n'est pas trosgros
sur http://www.cjoint.com tu indiques ton fichier avec
parcourir
clic sur créer le lien et tu obtiens un lien indiqué sur l'écran
et copié dans ton pressepapier
il faut venir coller ce lien ici dans un message
lSteph

"DC" a écrit dans le message de news:
43b65a75$0$6649$
Bonjour à tous................Joyeuse Fin d'Année et vive 2006...!!

Bonjour LSteph.........Merci de me répondre, malgrès cette chose sur
le feux,

Je t'ais envoyé le fichier complet sur http://www.cjoint.com
il se nomme "Feux tricolores" et j'espére avoir bien fait les choses,
mais çà reste à prouver, car j'ai un peu hésité dans la manoeuvre et
ne suis pas très sûr, du résultat, tu me tiens au courant
....Merci...!!

Cordialement.....Très Bonne Fin d'Année......un grand Merci...!!
.............DC










"LSteph" a écrit dans le message de news:

Re,
si tu le souhaite..va là http://www.cjoint.com poser ton fichier
et remets un lien ici j'y verrais directement plus clair.
ou si préfères en bal perso
cocosteph (cequivazaumilieu) free.fr

'lSteph


"DC" a écrit dans le message de news:
43b567e9$0$6641$
Bonsoir à tous,...........................Bonsoir LSteph,

Merci de ta réponse................Bonne fin d'année...!!

Je me suis enfin décidé à m'investir, dans ta procédure sur les
feux tricolores, effectivement après mult réflexions, rien à voir
avec mon bricolage; elle ressemble à une véritable procédure et
elle fonctionne très très bien,...... juste une petite chose, il
faudrait y ajouter la posibilité d'avoir 2 temporisations, ( 3 s )
pour les fonctions ( 1 + 2 + 4 + 5 ) et ( 10 s ) pour ( 3 + 6 ),
histoire de faire la différence entre l'orange et le vert et rouge

Voici les 6 cellules ( nommées ) et commandées par ta procédure (
123456 ), suivant qu'elles affichent ( 0 ou 1 ) elles agissent
sur d'autres cellules en MEFC ( allant jusqu'a 3 conditions de
couleurs ) et disposées en feux de carrefour
'------------------------------------------------------
Noms des
Cellules
rouge 0 10 S Rouge + Vert = 6
rouge_2bis 0 3 S Rouge + Rouge = 5
orange 0 3 S Orange + Rouge = 4
vert 0 10 S Vert + Rouge = 3
rouge_1bis 0 3 S Rouge + Rouge = 2
orange_bis 0 3 S Rouge + Orange = 1

'-----------------------------------------------------
Sub playlights()
Range("orange_bis").Select
With ActiveCell
Range(.Offset(0, 0), .Offset(-4, 0)) = 0
For I = 0 To 5
.Offset(-I, 0).Value = 1
couleur 3
.Offset(-I, 0).Value = 0
Next
End With
Application.OnTime Now + Second(temps), "playlights"
End Sub
'-----------------------------------------------------------
Sub couleur(temps)
Dim S As Double
S = Timer + 5
While Timer < S
DoEvents
Wend
End Sub
'------------------------------------------------
La procédure d'arrêt doit certainemment être mise comme code
feuille, mais je ne sais pas comment lui affecter un bouton,
'-------------------------------------------------
Private Sub CommandButton1_Click()
With commandbutton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"

playlights
End If
End With
End Sub
'-------------------------------------------------
Cordialement...........Merci d'avance........Joyeuses
Fêtes........DC

"LSteph" a écrit dans le message de news:
%
Bonsoir,
(Je suggérais f au lieu de F)
Il me semblait avoir écrit un truc semblable il y a peu et qui en
plus marchait mais bon...

Pour arrêter tout c'est End

exemple avec un bouton pour arrêter ou lancer la macro ici
"playlights":
'*****
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "Stop" Then
.Caption = "Start"
End
Else
.Caption = "Stop"
playlights

End If
End With
End Sub
'*******
'lSteph
"DC" a écrit dans le message de news:
43b40f76$0$19720$
Bonsoir à tous.............................Bonsoir LSteph,

Merci de ta réponse.....................Joyeuses Fêtes...!!

Je vais essayer d'ètre clair,......( à savoir que c'est un
amusement instructif...!! ), ...................rien de
plus..................

Avec Excel j'ai implanté un carrefour routier, donc un croisement
avec 4 feux et 6 situations possibles,
1) N/S = 3 s = rouge.................E/O = orange
2) N/S = 3 s = rouge.................E/O = rouge
3) N/S = 10 s = vert..................E/O = rouge
4) N/S = 3 s = orange...............E/O = rouge
5) N/S = 3 s = rouge.................E/O = rouge
6) N/S = 10 s = rouge...............E/O = vert
A chaque coin du carrefour = 3 cellules MEFC ( image des feux )
ces cellules sont gérées par 5 cellules commandes ( 0 = rien ) et
( 1 = couleurs )........et le tout géré par la procédure
ci-dessous,
'****************************************
Sub Feux_Rouge()
On Error GoTo Sortie
'--------------------------------------------
Application.Goto Reference:="orange_bis"
With Range("orange_bis")
End With
'--------------------------------------------
ActiveCell.FormulaR1C1 = "1"
Dim S As Double
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-----------------------------------------------
ActiveCell.Offset(-4, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'------------------------------------------------
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(-2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 3
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
S = Timer + 10
While Timer < S
DoEvents
Wend
ActiveCell.FormulaR1C1 = "0"
'-------------------------------------------------
Application.Run "'Feux tricolores.xls'!Feux_Rouge"

Sortie:
End Sub
'******************************************
Il me reste donc 1 autre macro, affectée au bouton Arrêt,
elle fonctionne très bien, le seul petit inconvénient
d'esthétique, est dans cette macro arrêt, avec l'apparition d'une
fenêtre VB que je fais disparaitre manuellement, avec la lettre F
de Fin,.....et ce que je veux faire,....... et bien, c'est
d'éviter l'apparition de cette fenêtre, ou qu'elle disparaisse,
avec la procédure de la macro Arrêt, ...........c'est dire la
difficulté, inutile de la chose, n'est-ce pas...!!

Merci d'avance...!!...............j'espére avoir été clair, mais
bon...!!

Voici la macro Arrêt, ( modifiée, mais même résultat )
'*********************************
Sub Test_Arret()

ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "^{Break}", 1
SendKeys "{F,f"}"

End Sub
'***************************************

Cordialement.........Merci beaucoups........bonne
soirée...!!...DC

"LSteph" a écrit dans le message de news:
%
Bonjour DC,

déjà ceci
SendKeys "{Ctrl,Pause}"
ne va pas

SendKeys "^{Break}", 1

sinon
F , f"
et surtout
Que veux tu faire ?

lSteph


"DC" a écrit dans le message de news:
43b3c4f2$0$18325$
Bonjour à tous,..................Excel 2000 sous XP

Merci de me lire................Bonne Journée...!!

Voilà, je dispose d'une procédure qui tourne en boucle et qui
fonctionne avec un bouton marche et un bouton arrêt, mon petit
problème est dans la macro arrêt, ci-dessous,
'---------------------------------------------------------
Sub Test_Arret()
'
ActiveCell.FormulaR1C1 = "0"
Range("N30").Select
SendKeys "{Ctrl,Pause}"
SendKeys "{F}"

End Sub
'--------------------------------------------------------
C'est le [ SendKeys"{F}" ] qui ne veut rien savoir, si je le
fait manuellement au clavier, la fenêtre VB disparait, je
suppose que le
( Ctrl,Pause ) à mis la macro en pause, et l'ordre suivant
n'est pas pris en compte, mais est-ce qu'il y à une astuce pour
remédier à cet inconvénient...............Merci d'y penser...!!

Cordialement.....Merci d'avance.....Joyeuses Fêtes...!!......DC















































1 2