Intercepter un clic dans un userform pendant l'exécution d'une macro

**ouskel'n'or** · 04/04/2008, 23h52

Dans un userform j'ai une procédure assez longue que je souhaiterais pouvoir interrompre à l'aide d'un clic de souris quand j'ai obtenu un certain résultat, mais pas nécessairement, pouvant souhaiter que la procédure se poursuive.
Un test sur le résultat en question qui interromprait la procédure n'est pas possible, ce résultat n'étant pas connu à l'avance.
Seul l'oeil peut dire au bon moment "j'arrête !" ou "j'arrête pas !"
J'ai pensé le faire en interceptant la frappe d'une touche mais j'ai le souvenir d'un code assez lourd et peu fiable, faisant appel entre autres à GetAsyncKeyState, Addressof, SetTimer et autres amusant KillTimer (qui, lui, fonctionnait une fois sur deux)
Bref, ça fonctionne parfois mais cépaça.
En fait, ce que je veux, c'est pouvoir interrompre une macro quand je veux mais conserver les résultats déjà obtenus.

Il y a peut-être quelque chose à faire avec EnableEvents mais je ne vois pas

Si quelqu'un avait une idée, je serais très content

Par avance, merci.

**fring** · 05/04/2008, 01h29

Salut Ousk,

Jette un oeil sur le fichier joint si ce petit bout de code répond à tes attentes.

Pièce jointe 28098

**ouskel'n'or** · 05/04/2008, 11h21

Merci, Fring,
Ça y est, je me suis levé bien réveillé et j'ai trouvé !
J'avais essayé ta solution mais elle ne fonctionnait pas parce que je voulais utiliser le même bouton. Or j'avais mis le code dans l'événement Click si bien que le bouton restait inaccessible ("enfoncé")
La solution ? Passer le code dans MouseUp. Le bouton conserve le focus mais répond aux événements.
C'est tout à fait ce qui me convient.
Ainsi je peux utiliser le même bouton qui passe de "Lancer la macro" à "Interrompre la macro" selon que le boolean est true ou false.
Merci beaucoup, c'est bien ta solution qui m'a conduit à voir un peu plus loin que le click d'un bouton

Si ça t'intéresse de savoir ce que j'en ai fait, regarde l'userform, ici

**fring** · 05/04/2008, 11h42

Joli

Mais j'ai un bug au survol de la souris, sur cette ligne

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
Public Function ChercherPartout(PathRep As String, NomFich As String, Optional SousRep As Boolean = True) As Boolean
Dim fs, f, NomRep, RepFich As Variant
Set fs = CreateObject("Scripting.FileSystemObject")
    If Not Go Then Exit Function
    Me.Label1.Caption = "Recherche dans le répertoire " & vbCr & PathRep
    DoEvents
    PathRep = PathRep & "\"
    If Dir(PathRep & NomFich) <> "" Then   <---
        Me.ListBox1.AddItem PathRep
    End If
    If SousRep Then
        For Each RepFich In fs.GetFolder(PathRep).SubFolders
            PathRep = RepFich.shortpath
            ChercherPartout = ChercherPartout + ChercherPartout(PathRep, NomFich, SousRep)
        Next RepFich
    End If
    ChercherPartout = ListBox1.ListCount > 0
End Function

Je verrais bien aussi 2 Combo's, une qui permettrait de sélectionner la partition (à l'initialisation du Usf un check serait fait pour vérifier les partitions existantes) et l'autre qui permettrait de sélectionner le type de fichier (choix de l'extension via une liste déroulante) avec pour cette dernière une possibilité "autre" qui laisserait l'utilisateur introduire l'extension manuellement afin de se limiter à faire une liste d"extensions courantes

**ouskel'n'or** · 05/04/2008, 11h56

Envoyé par fring

Mais j'ai un bug au survol de la souris, sur cette ligne

Là, je ne comprends pas, je n'ai aucun test sur un événement mousemove dans l'userform. Seuls s'affichent les ControlTipText mais là, je ne comprendrais pas une interaction...
Tu peux préciser les conditions ?
Pour une liste des volumes, j'y ai pensé mais ce sera pour une prochaine version. Au départ, je voulais compter les fichiers d'un répertoire... Et puis je me suis dit...

pour les extensions, je pourrais carrément les supprimer du test. Mais je devrai alors les ajouter dans la listbox. C'est faisable. On verra ça dans "V.0.2" s'il s'avère que mon bidule intéresse les gens

Tu me dis pour le passage de la souris ?
Merci
A+

**fring** · 05/04/2008, 12h06

Envoyé par ouskel'n'or

Tu peux préciser les conditions ?

Température : 8°C
Vent : 19km/h, orientation Ouest
Pression : 1010 millibars
Humidité : 93%

Edit : Apparement le lien vers l'autre post n'est plus valide
ReEdit : même si je le laisse terminer sa recherche, il bug sur cette même ligne lorqu'elle est terminée

**ouskel'n'or** · 05/04/2008, 12h19

Comme je n'ai rien de tel, je vais te poser une question indiscrète : Tu es sur quelle version d'Excel ?
(pendant que tu me réponds, je vais ajouter Option Explicit s'il n'y est pas... sait-on jamais...)
A+

Edit
Il y est bien
Pour le lien, j'ai effectivement remplacé le fichier, tu peux de nouveau tester ?
Merci

**fring** · 05/04/2008, 12h19

Ya une ligne que je ne comprend pas dans ton code

Code :

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

NomFich = Me.ListBox1 & Me.TextBox2

NomFich ne devrait pas être égale à ?

Code :

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

NomFich = Me.TextBox2

Edit : Excel 2000 Avant JC

**ouskel'n'or** · 05/04/2008, 12h31

ListBox1 contient le répertoire, TextBox2 le nom du fichier.
Peux-tu regarder ma réponse précédente ?
A+

C'est d'ailleurs pourquoi j'avais précisé

Envoyé par ousk'

pour les extensions, je pourrais carrément les supprimer du test. Mais je devrai alors les ajouter dans la listbox.

avec le nom du fichier, bien sûr !

Edit
J'ai corrigé le lien

Tiens, je m'aperçois que j'ai deux variables qui ne servent à rien... Je vais faire le ménage (et changer le lien...

)

**fring** · 05/04/2008, 12h36

Le problème vient sans doute de là, chez moi ça donne :

nom du répertoire = TextBox1
nom du fichier = TextBox2
résultat de la recherche = ListBox1

**fring** · 05/04/2008, 12h42

Je n'ai rien dit...je regardais dans la macro "Ouvrir" où là NomFich est bien ListBox1 + TextBox2

**ouskel'n'or** · 05/04/2008, 13h13

Ouf !
Et pour le bug de la souris ? Tu peux le reproduire ? En as-tu toujours 1 sur

If Dir(PathRep & NomFich) <> "" Then <---

Tu m'inquiètes car là, je ne vois pas ce que je dois modifier

**fring** · 05/04/2008, 13h30

Oui

et j'ai également ce bug à la fin de la recherche, sans avoir manipulé la souris, pour le moment je ne vois pas non plus pourquoi ça couine

**ouskel'n'or** · 05/04/2008, 13h47

J'ai peut-être une idée. Je teste quelque chose.
Mon idée : Certains tests censés retourner un string renvoient un boolean s'ils sont négatifs (je n'ai pas l'exemple en mémoire et si je le cite, c'est au cas où quelqu'un ait un exemple

)
Bref, quand je teste PathRep & NomFich) <> ""
Mon interrogation est : Que renvoie Dir dans ce cas là ? un boolean ou un une chaîne vide ?
Si c'est un boolean, à part une gestion d'erreur, je ne vois pas par quel test remplacer.
Tu as une idée ?

Mon problème est aussi que je ne peux pas reproduire l'erreur que tu constates

**fring** · 05/04/2008, 14h10

Il y a une évolution, j'ai ajouté "On Error Resume Next" avant Dir(pathrep & nomfich), là il poursuit la recherche jusqu'au bout sans buguer mais un truc zarbi qui se produit chez moi, il me trouve bien le ou les fichiers dans les différents sous-répertoires et en fin de recherche il commence à ajouter dans la liste des résultats trouvés

Code :

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

1
2
3
4
5
6
7
8
9
D:\System~1\
D:\System~1\\
D:\System~1\\\
D:\System~1\\\\
D:\System~1\\\\\
D:\System~1\\\\\\
D:\System~1\\\\\\\
D:\System~1\\\\\\\\
...etc...des lignes et des lignes chaque fois incrémentées d'une \

**ucfoutu** · 05/04/2008, 14h13

Bonjour,

Lorsque vous en aurez fini et serez tout à fait prêts à exposer les tenants et aboutissants sans xls interposé (je ne mettrrais en effet jamais un xls et encore moins un xla en route ...

), faites signe, hein ...

**ouskel'n'or** · 05/04/2008, 14h15

Tiens, j'ai recréé complètement mon fichier sur VBA 97... Toujours pas d'erreur, tu peux le tester. Pièce jointe 28115
A+

**ouskel'n'or** · 05/04/2008, 14h19

Envoyé par ucfoutu

Bonjour,

Lorsque vous en aurez fini et serez tout à fait prêts à exposer les tenants et aboutissants sans xls interposé (je ne mettrrais en effet jamais un xls et encore moins un xla en route ...

), faites signe, hein ...

Hello, tu es réveillé ?
Pour ton info, tu sais qu'ici on est sur le forum VBA - Excel ?
Mais bon un forum c'est fait pour échanger des points de vue

Ceci dit, que demandes-tu que je passe ma procédure sur VB6 ?

A+