Stopper une macro par macro

Version imprimable

Bonjour,

J'ai une macro Workbook_Open qui réalise une tache qui boucle à l'infini (c'est exprès, construction des nombres premiers sur une colonne).

J'ai ajouté un Userform qui se loade au début demandant de patienter (Label), devant afficher régulièrement le dernier premier trouvé (Textbox) et muni d'un bouton Stop.

L'idée étant bien sûr qu'un click sur ce bouton arrète la macro. Pour l'instant l'Userform se charge bien et rien ne se passe (j'arrète même Excel avec le gestionnaire de tâches :?). Le suivi du code avec F8 devient impossible des que l'Userform se loade.

J'ai déclarée une variable pbStop (boolénne) publique en tête d'un module.
CommandButton1_Click ne contient que

Code:

pbStop = True

Cette variable, déclarée fausse, en début de macro est ensuite testée lors de l'écriture de chaque premier.

Le code de la macro :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Private Sub Workbook_Open()
 
'construit les 1er en colonne1
 Dim vTst As Long
 Dim x As Long
 Dim j As Long
 Dim d, f, t
 Dim vRw As Long
 Dim vLLV As Long
 Dim vLLR As Long
 Dim vbFE As Boolean
 Dim vTime1, vTime2
 
    Stop
    pbStop = False 'ne pas stopper la macro
    vTime1 = Now
 
    'vérifie que la feuille 1er existe, sinon la crée, l'activer dans tous les cas
    vbFE = FeuilleExiste("1er")
    If vbFE = False Then
        Sheets.Add
        ActiveSheet.Name = "1er"
    Else
        Worksheets("1er").Activate
    End If
 
    'chargement userform (un label, un bouton stop, une textbox affichant à intervalle régulier le dernier 1er calculé
    Load Prm1
    Prm1.Show
 
    'ou en était t-on resté dans la construction de la liste ?
    vLLR = Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
    vLLV = Cells(vLLR, 1) 'sa valeur
 
    'Affichage dans textbox
    If vLLV = "" Then
        Prm1.TextBox1.Text = ""
    Else
        Prm1.TextBox1.Text = vLLV
    End If
 
    'déterminer nombre à tester et dernière ligne d'écriture
    If vLLR = 1 Then
        Cells(1, 1) = 1
        Cells(2, 1) = 2
        vTst = 2
        vRw = 2
    Else
        vTst = vLLV
        vRw = vLLR
    End If
 
    'traitement
Line0:
    vRw = vRw + 1 'le prochain premier s'écrira à cette ligne
line1:
    vTst = vTst + 1 'nombre à tester
    For j = 2 To vRw - 1 'pour chaque premier précédemment testé
        If vTst Mod Cells(j, 1) = 0 Then GoTo line1 'ce n'est pas un premier
        If vTst / Cells(j, 1) < Cells(j, 1) Then GoTo Line3 'inutile d'aller plus loin, c'est un premier
    Next j
Line3:
    Cells(vRw, 1) = vTst 'écriture du premier
    vTime2 = Now
    If vTime2 - vTime1 > 0.0001 Then 'actualisation régulière textbox
        Prm1.TextBox1.Text = vTst
        vTime1 = Now
    End If
    If pbStop = True Then 'arréter la macro
        Unload Prm1 '
        Exit Sub
    End If
    GoTo Line0
 
End Sub

Est -il impossible que deux macros tournent en même temps ? Et si oui quelqu'un aurait-il une autre approche à me suggérer ?

Edit : placer la macro dans l'initialisation de l'Userform par exemple ?

Cordialement

R

27/01/2011, 09h58
tedo01

Bonjour,
Moi je mettrais déjà un DoEvents dans la boucle, histoire que le système puisse reprendre la main de temps en temps :)
27/01/2011, 19h25
GuyXL

Bonjour,

Merci Tedo!

Problème (a peu près) résolu. J'avais oublié de précisé le paramètre faux dans

Code:

Prm1.Show (False)

et j'ai ajouté

Code:

DoEvents

après la ligne

Code:

If vTime2 - vTime1 > 0.0001 Then

. Je ne suis pas sur de l'avoir bien placé... Moyennant quoi, l'userform reste blanc quelques secondes à l'ouverture, après il fait ce que je veux et quand je clique sur le bouton Stop la macro s'arrête une poignée de secondes après. Du coup c'est moins convivial que prévu mais ça marche à condition que je ne réduise pas le laps de temps. Un essai avec 0,001 pour la différence des vTime laisse toujours l'Userform blanc mais je peux stopper la macro avec échap. Il n'y'a pas un bouton 'Presque résolu' ? ;)

R
27/01/2011, 19h48
tedo01

Re,
Peut-être que ce serait plus réactif avec un DoEvents après la ligne

Code:

For j = 2 To vRw - 1

Cette instruction redonne brièvement la main au système, il faut donc faire des essais pour choisir le meilleur emplacement...

Problème résolu!

Si je n'abuse pas quel est le raisonnement qui t'as conduit à choisir cet endroit en premier, alors que la ligne qui change la valeur de la textbox est juste après l'endroit ou je l'avais placé ? En tout cas c'est parfait, l'Userform s'affiche bien de suite et le stop arrête la macro instantanément. Un grand merci.

R

Edit : Ca marche tellement bien que j'ai enlevé les tests temporels. Même si cet affichage ralentit les calculs, quel plaisir de regarder oisivement Excel travailler. :ccool:

Dans ThisWorkbook

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
 
Private Sub Workbook_Open()
 
'construit les 1er en colonne1
 Dim vTst As Long
 Dim x As Long
 Dim j As Long
 Dim d, f, t
 Dim vRw As Long
 Dim vLLV As Long
 Dim vLLR As Long
 Dim vbFE As Boolean
 Dim vTime1, vTime2
 
    pbStop = False 'ne pas stopper la macro
    'vTime1 = Now
 
    'vérifie que la feuille 1er existe, sinon la crée, l'activer dans tous les cas
    vbFE = FeuilleExiste("1er")
    If vbFE = False Then
        Sheets.Add
        ActiveSheet.Name = "1er"
    Else
        Worksheets("1er").Activate
    End If
 
    'chargement userform (2 labels, 1 bouton stop)
    Load Prm1
    Prm1.Show (False)
 
    'ou en était t-on resté dans la construction de la liste ?
    vLLR = Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
    vLLV = Cells(vLLR, 1) 'sa valeur
 
    'Affichage Label2
    If vLLV = 0 Then
        Prm1.Label2.Caption = ""
    Else
        Prm1.Label2.Caption = vLLV
    End If
 
    'déterminer nombre à tester et dernière ligne d'écriture
    If vLLR = 1 Then
        Cells(1, 1) = 1
        Cells(2, 1) = 2
        vTst = 2
        vRw = 2
    Else
        vTst = vLLV
        vRw = vLLR
    End If
 
    'traitement
Line0:
    vRw = vRw + 1 'le prochain premier s'écrira à cette ligne
line1:
    vTst = vTst + 1 'nombre à tester
    For j = 2 To vRw - 1 'pour chaque premier précédemment testé
        DoEvents
        If vTst Mod Cells(j, 1) = 0 Then GoTo line1 'ce n'est pas un premier
        If vTst / Cells(j, 1) < Cells(j, 1) Then GoTo Line3 'inutile d'aller plus loin, c'est un premier
    Next j
Line3:
    Cells(vRw, 1) = vTst 'écriture du premier
    Prm1.Label2.Caption = vTst 'Actualise Label2
 
    If pbStop = True Then 'arréter la macro
        Unload Prm1 '
        Exit Sub
    End If
 
    GoTo Line0
 
End Sub

Dans l'Userform

Code:

1
2
3
4
5
6
7
8
9
10
Option Explicit
 
Private Sub CommandButton1_Click()
    pbStop = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub

Dans un module

Code:

1
2
3
Option Explicit
 
Public pbStop As Boolean

27/01/2011, 23h02
tedo01

Re,
Je t'explique volontiers : mon raisonnement a été d'avoir, au moment de l'exécution, le moins possible de lignes de code qui s'exécutent entre deux instructions DoEvents... ce qui s'obtient en interrompant l'exécution à chaque passage dans la boucle "For j = 2 To vRw - 1".
Est-ce que ça t'éclaire sur l'utilisation de DoEvents ?

Sauf que pour organiser son code, les goto sont à mon goût assez rudes (c'est l'héritage de l'ancien basic)
ton code pourrait être ainsi structuré (entre autre)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub Workbook_Open()
Dim Sh As Worksheet
Dim Sortie As Boolean
Dim vTst As Long, vRw As Long
Dim vLL As Range
Dim j As Long
 
'construit les 1er en colonne1
On Error Resume Next
Set Sh = Worksheets("1er")
On Error GoTo 0
If Sh Is Nothing Then
   Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
   Sh.Name = "1er"
End If
With Sh
   'ou en était t-on resté dans la construction de la liste ?
   Set vLL = .Cells(Rows.Count, 1).End(xlUp)  'dernière ligne
   'chargement userform (2 labels, 1 bouton stop)
   Prm1.Show (False)
   'Affichage Label2
   Prm1.Label1.Caption = IIf(vLL.Value = 0, "", vLL.Value)
 
   'déterminer nombre à tester et dernière ligne d'écriture
   If vLL.Row = 1 Then
      .Cells(1, 1).Value = 1
      .Cells(2, 1).Value = 2
      vTst = 2
      vRw = 2
   Else
      vTst = vLL.Value
      vRw = vLL.Row
   End If
   Set vLL = Nothing
   'traitement
   Do
      vTst = vTst + 1   'nombre à tester
      For j = 2 To vRw   'pour chaque premier précédemment testé
         DoEvents
         If vTst Mod .Cells(j, 1).Value = 0 Then
            Sortie = True   'ce n'est pas un premier
            Exit For
         End If
         If .Cells(j, 1).Value > (vTst / .Cells(j, 1).Value) Then Exit For  'inutile d'aller plus loin, c'est un premier
      Next j
      If Not Sortie Then
         vRw = vRw + 1   'le prochain premier s'écrira à cette ligne
         .Cells(vRw, 1).Value = vTst   'écriture du premier
         Prm1.Label2.Caption = vTst   'Actualise Label2
      End If
      Sortie = False
   Loop Until pbstop
End With
Set Sh = Nothing
Unload Prm1         '
End Sub

28/01/2011, 19h48
GuyXL

Bonjour le fil,

@Tedo : Ca m'éclaire bien. Je pars du principe que si on a besoin de rendre la main au système il faut bourriner sur le DoEvents comme certains le feraient sur la touche Echap quand un programme part en vrille ;-) Ca humanise un peu le langage vba je trouve..

@Mercatog : J'ai testé le code et il semble aller bien plus vite et est plus propre. Je voulais comparer la vitesse des deux mais je n'ai pas su ou mettre une sortie (quand vTst > 100000 par ex) sur le tien, ou plutôt quand j'ai essayé le code n'a pas aimé. Une autre chose, avec le code précédent je pouvais lancer la macro de l'éditeur alors que le tien fait une seule boucle et puis s'arrête "normalement". Je n'ai pas encore comparé les deux codes pas à pas en surveillant les variables ceci dit.
J'avais déjà croisé, dans des posts ou autres documentations les Is Nothing, IIf, Exit For, If Not, Do...Loop Until sans jamais les utilisé. J'ai la fâcheuse tendance quand je trouve à traduire ce que j'ai en tête à trop rarement pousser plus loin pour voir si il n'y aurai pas plus efficace. Ton code me motive à changer mon fusil d'épaule.

Merci à vous deux.

R