Problème rencontré sur arrêt exécution d'1 macro en cours de fonctionnement

**capi81** · 16/07/2012, 11h43

Bonjour à tous

Merci de me donner un coup de main sur les difficultés que je vous expose.
En effet, le code ci-dessous me permet de remplir automatiquement un logiciel à partir des données d’une plage de donnée excel.
Le remplissage se fait bien mais s’il y’a une difficulté que je rencontre réellement, c’est concernant l’arrêt de la macro en cours de fonctionnement.
Il faut dire également qu’il y’a eu une combinaison dans le code qui me permet de pouvoir arrêter le remplissage dans mon logiciel.
Lorsque je fais ESC, le remplissage est interrompu et une boîte de dialogue s’affiche avec le message suivant : « Confirmation arrêt macro ».
Une fois la confirmation faite, lorsque je viens à exécuter à nouveau la macro, la boîte de dialogue s’affiche encore quand bien même j’ai pas appuyer sur la touche ESC. Je suis obliger de faire de manipulations au hasard pour que le remplissage automatique de réalise.
Voila pourquoi j’ai besoin de vos expertises sur le code pour voir ce qui ne va pas et ce qui est faisable.
Que DIEU vous bénisse.

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Option Explicit
Declare Function GetKeyState Lib "user32" (ByVal nvirtkey As Long) As Integer
Dim noaction As Boolean
 
Sub activesimple()
Dim I As Integer, MemJ8 As Integer
'On Error GoTo gestionerreur
If MsgBox("ASSUREZ-VOUS QUE VOTRE SESSION", vbYesNo, "Demande de confirmation") = vbYes Then
noaction = False
AppActivate "ICI NOM DU LOGICIEL"
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
For I = 3 To 45
' Si I = 8 alor on mémorise la valeur de la cellule
If I = 8 Then MemJ8 = Range("J8").Value
' Si I = 16 ou 17
If I = 16 Or I = 17 Then
' Si la veleur mémorisée est 3
If MemJ8 = 3 Then
' On inscrit le nom et le prénom du mari
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Next
 
SendKeys "+{F3}"
attendre 1
If noaction Then Exit Sub
 
For I = 46 To 53
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
Next
SendKeys "+{F6}"
attendre 1
If noaction Then Exit Sub
 
For I = 53 To 53
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
Next
 
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
End If
End Sub
 
Sub activePack()
Dim I As Integer, MemJ8 As Integer
 
'On Error GoTo gestionerreur
If MsgBox("ASSUREZ-VOUS QUE VOTRE", vbYesNo, "Demande de confirmation") = vbYes Then
noaction = False
AppActivate "ICI NOM DU LOGICIEL"
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
For I = 3 To 6
    SendKeys Cells(I, 10).Value, True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "~"
    attendre 1
    If noaction Then Exit Sub
Next
    SendKeys "N" & Chr(13), True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "{LEFT}"
    SendKeys "{ENTER}"
    attendre 1
    If noaction Then Exit Sub
 
For I = 7 To 45
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
'For I = 3 To 45
' Si I = 8 alor on mémorise la valeur de la cellule
If I = 8 Then MemJ8 = Range("J8").Value
' Si I = 17 ou 18
' si I = 7
 
If I = 17 Or I = 18 Then
' Si la veleur mémorisée est 3
If MemJ8 = 3 Then
 
' On inscrit le nom et le prénom du mari
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Next
    SendKeys "+{F3}"
    attendre 1
    If noaction Then Exit Sub
For I = 46 To 53
    SendKeys Cells(I, 10).Value, True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "~"
    attendre 1
    If noaction Then Exit Sub
 
Next
    SendKeys "+{F6}"
    attendre 1
    If noaction Then Exit Sub
 
'For I = 51 To 51
    'SendKeys Cells(I, 10).Value, True
    'attendre 0.6
    'SendKeys "~"
    attendre 1
End If
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
 
End Sub
 
Sub attendre(sec%)
Dim deb&, fin&
deb = Timer
fin = deb + sec%
Do Until Timer >= fin
DoEvents
If GetKeyState(27) > 0 Then
If MsgBox("Confirmation arrêt macro", vbOKCancel + vbQuestion) = vbOK Then
SendKeys Chr(27)
noaction = True
Exit Sub
End If
End If
Loop
End Sub

**Daniel.C** · 16/07/2012, 12h28

Bonjour,

Essaie peut-être comme ceci (non testé) :

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Option Explicit
Public Var
Declare Function GetKeyState Lib "user32" (ByVal nvirtkey As Long) As Integer
Dim noaction As Boolean
 
Sub activesimple()
Dim I As Integer, MemJ8 As Integer
'On Error GoTo gestionerreur
If MsgBox("ASSUREZ-VOUS QUE VOTRE SESSION", vbYesNo, "Demande de confirmation") = vbYes Then
noaction = False
AppActivate "ICI NOM DU LOGICIEL"
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
For I = 3 To 45
' Si I = 8 alor on mémorise la valeur de la cellule
If I = 8 Then MemJ8 = Range("J8").Value
' Si I = 16 ou 17
If I = 16 Or I = 17 Then
' Si la veleur mémorisée est 3
If MemJ8 = 3 Then
' On inscrit le nom et le prénom du mari
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Next
 
SendKeys "+{F3}"
attendre 1
If noaction Then Exit Sub
 
For I = 46 To 53
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
Next
SendKeys "+{F6}"
attendre 1
If noaction Then Exit Sub
 
For I = 53 To 53
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
Next
 
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
End If
End Sub
 
Sub activePack()
Dim I As Integer, MemJ8 As Integer
Var = 0
'On Error GoTo gestionerreur
If MsgBox("ASSUREZ-VOUS QUE VOTRE", vbYesNo, "Demande de confirmation") = vbYes Then
noaction = False
AppActivate "ICI NOM DU LOGICIEL"
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
For I = 3 To 6
    SendKeys Cells(I, 10).Value, True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "~"
    attendre 1
    If noaction Then Exit Sub
Next
    SendKeys "N" & Chr(13), True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "{LEFT}"
    SendKeys "{ENTER}"
    attendre 1
    If noaction Then Exit Sub
 
For I = 7 To 45
 
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE IGOR SOUHAITE
'For I = 3 To 45
' Si I = 8 alor on mémorise la valeur de la cellule
If I = 8 Then MemJ8 = Range("J8").Value
' Si I = 17 ou 18
' si I = 7
 
If I = 17 Or I = 18 Then
' Si la veleur mémorisée est 3
If MemJ8 = 3 Then
 
' On inscrit le nom et le prénom du mari
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(I, 10).Value, True
attendre 0.6
If noaction Then Exit Sub
SendKeys "~"
attendre 1
If noaction Then Exit Sub
End If
Next
    SendKeys "+{F3}"
    attendre 1
    If noaction Then Exit Sub
For I = 46 To 53
    SendKeys Cells(I, 10).Value, True
    attendre 0.6
    If noaction Then Exit Sub
    SendKeys "~"
    attendre 1
    If noaction Then Exit Sub
 
Next
    SendKeys "+{F6}"
    attendre 1
    If noaction Then Exit Sub
 
'For I = 51 To 51
    'SendKeys Cells(I, 10).Value, True
    'attendre 0.6
    'SendKeys "~"
    attendre 1
End If
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
 
End Sub
 
Sub attendre(sec%)
Dim deb&, fin&
deb = Timer
fin = deb + sec%
Do Until Timer >= fin
DoEvents
Var = GetKeyState(27)
If Var > 0 Then
If MsgBox("Confirmation arrêt macro", vbOKCancel + vbQuestion) = vbOK Then
SendKeys Chr(27)
noaction = True
Var = 0
Exit Sub
End If
End If
Loop
End Sub

**capi81** · 16/07/2012, 14h08

Salut Daniel.C
Merci pour votre intervention.
Je viens de tester mais c'est toujours la même chose.
Rien de changer

Problème rencontré sur arrêt exécution d'1 macro en cours de fonctionnement

Macros et VBA Excel

Discussions similaires

Partager

Partager