Lancer une macro durant l'éxécution d'une autre

darts41

XLDnaute Nouveau
Bonjour à tous,

VBA sous excel 2003

J'ai une boucle qui tourne indéfiniment pour incrémenter une valeur de cellule à intervalles réguliers (ex toutes les 10 secondes). Durant l'exécution de cette boucle, je n'ai plus accès à aucun bouton, et le problème est que je souhaiterais pouvoir cliquer sur un bouton lançant une autre macro qui m'incrémenterait la valeur d'une autre cellule (à chaque clic).

En clair, j'ai une cellule qui m'indique les appareils qui auraient dûs être fabriqués (incrément automatique), et une autre qui indique ceux fabriqués
(incrément manuel).
J'ai beau tourner sur les forums, mais je n'ai pas encore trouvé de réponse acceptable. Si vous avez d'autres idées je suis preneur

Merci
Cyril
 

Softmama

XLDnaute Accro
Re : Lancer une macro durant l'éxécution d'une autre

Bonjour,

Sans fichier joint, difficile de se faire une idée acceptable de ton problème. Néanmoins, et à priori, je pense que tu peux placer un DoEvents au départ de ta boucle qui se lance toutes les 10 secondes au moyen d'un application.Ontime
 
Dernière édition:

darts41

XLDnaute Nouveau
Re : Lancer une macro durant l'éxécution d'une autre

Echec, mon fichier épuré au max fait toujours plus de 43ko.
Voici donc le code

Code lançant la boucle
Sub Prevu()
Sheets("Compteur").Range("G8").Value = 0
Sheets("Compteur").Range("A8").Value = 0
TimeOnOff = True

Application.ScreenUpdating = False
Cycle = Sheets("Compteur").Range("B3").Value
While TimeOnOff = True
Start = Timer
CompteurTemps = 0
While CompteurTemps < Cycle
CompteurTemps = Timer - Start
Wend
Application.ScreenUpdating = True
Sheets("Compteur").Range("G8").Value = Sheets("Compteur").Range("G8").Value + 1
Application.ScreenUpdating = False
Wend

Application.ScreenUpdating = True
End Sub

Macro à lancer durant l'exécution de la boucle
Private Sub CommandButton1_Click()
Sheets("Compteur").Range("A8").Value = Sheets("Compteur").Range("A8").Value + 1
End Sub


Merci de m'indiquer où insérer le DoEvents et comment articuler le tout

@+ Cyril
 

Pierrot93

XLDnaute Barbatruc
Re : Lancer une macro durant l'éxécution d'une autre

Re,

essaye peut être comme ceci :
Code:
Sub Prevu()
Sheets("Compteur").Range("G8").Value = 0
Sheets("Compteur").Range("A8").Value = 0
TimeOnOff = True

Application.ScreenUpdating = False
Cycle = Sheets("Compteur").Range("B3").Value
While TimeOnOff = True
Start = Timer
CompteurTemps = 0
[B][COLOR="Blue"]DoEvents[/COLOR][/B]
While CompteurTemps < Cycle
CompteurTemps = Timer - Start
[B][COLOR="Blue"]DoEvents[/COLOR][/B]
Wend
Application.ScreenUpdating = True
Sheets("Compteur").Range("G8").Value = Sheets("Compteur").Range("G8").Value + 1
Application.ScreenUpdating = False
Wend

Application.ScreenUpdating = True
End Sub
 

darts41

XLDnaute Nouveau
Re : Lancer une macro durant l'éxécution d'une autre

Merci Pierrot, et les autres

En compilant tout ce que vous m'avez dit, j'arrive à un résultat satisfaisant avec ce code


________________________________________________________
Dim Arret As Boolean

Private Sub Arreter_Click()

Arret = False
End Sub
_____________________________________________________
Private Sub Lancer_Click()
Arret = True
x = 1
Sheets("Compteur").Range("H8").Value = 0
Sheets("Compteur").Range("B8").Value = 0

Cycle = Sheets("Compteur").Range("C3").Value
Do While x < 1000000
Start = Timer
CompteurTemps = 0
Do While CompteurTemps < Cycle
CompteurTemps = Timer - Start
Lancer.Caption = CompteurTemps
If Arret = False Then
Lancer.Caption = "Lancer"
Exit Do
End If
DoEvents
Loop
If Arret = False Then
Lancer.Caption = "Lancer"
Exit Do
End If
Sheets("Compteur").Range("h8").Value = Sheets("Compteur").Range("h8").Value + 1
If Sheets("Compteur").Range("H8").Value > Sheets("Compteur").Range("b8").Value Then
Sheets("Compteur").Range("B8").Interior.ColorIndex = 3
Else: Sheets("Compteur").Range("B8").Interior.ColorIndex = 4
End If
DoEvents
Loop
End Sub
____________________________________________
Private Sub CommandButton1_Click()
Sheets("Compteur").Range("B8").Value = Sheets("Compteur").Range("B8").Value + 1
If Sheets("Compteur").Range("H8").Value > Sheets("Compteur").Range("B8").Value Then
Sheets("Compteur").Range("B8").Interior.ColorIndex = 3
Else: Sheets("Compteur").Range("B8").Interior.ColorIndex = 4
End If
End Sub
___________________________________________

Qu'en pensez-vous?

Merci
 

Etienne2323

XLDnaute Impliqué
Re : Lancer une macro durant l'éxécution d'une autre

Salut Darts41,
je viens simplement me glisser dans votre conversation pour vous proposer les options qui sont selon moi les plus simples.

1) Avez-vous penser à zipper votre fichier ?

2) S'il dépasse toujours la taille miniale requise sur le forum, vous pouvez toujours essayer ce site pour déposer votre fichier : Cijoint.fr - Service gratuit de dépôt de fichiers

Cordialement,

Étienne
 

darts41

XLDnaute Nouveau
Re : Lancer une macro durant l'éxécution d'une autre

Merci Etienne2323,

Voici le fichier en question au format .zip
J'attends vos commentaires, car il y a peut-être plus simple.

Cyril
 

Pièces jointes

  • Compteur1.zip
    24.4 KB · Affichages: 44
  • Compteur1.zip
    24.4 KB · Affichages: 53
  • Compteur1.zip
    24.4 KB · Affichages: 50

Softmama

XLDnaute Accro
Re : Lancer une macro durant l'éxécution d'une autre

Bonsoir darts41,

J'ai étudié ton code, il est plutôt pas mal. J'ai modifié quelques lignes, histoire de : placé des with sheets("Compteur") ... end with à 2 3 endroits. Supprimé la variable x qui sert à rien.

cf. fichier joint
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 952
Messages
2 093 888
Membres
105 861
dernier inscrit
Chloe.obsr