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

zombe

XLDnaute Occasionnel
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:
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
 

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 868
dernier inscrit
JJV