Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

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

10 réponses

1 2
Avatar
LSteph
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
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,
(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
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,
...ok !
là , j'ai autre chose sur le feu..
mais je regarderai.
A+
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
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
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
Bonjour,
à l'adresse indiquée 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
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
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