Discussion :

[GuyXL]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[GuyXL]

Bonjour,

Merci Tedo!

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Prm1.Show (False)

et j'ai ajouté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DoEvents

après la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[tedo01]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[GuyXL]

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.


Dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Option Explicit
 
Public pbStop As Boolean

[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 ?