Problème de boucle sur programmation VBA

Résolu/Fermé
mic13710 Messages postés 1088 Date d'inscription samedi 26 novembre 2005 Statut Membre Dernière intervention 13 mai 2021 - 9 mars 2009 à 17:39
mic13710 Messages postés 1088 Date d'inscription samedi 26 novembre 2005 Statut Membre Dernière intervention 13 mai 2021 - 10 mars 2009 à 13:04
Bonjour,

J'ai un code qui me permet de rechercher des données suivant la dernière cellule active dans un range. Il fonctionne assez bien. Ce code est écrit au niveau Worksheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Static ILIG_SELECT As Integer, ICOL_SELECT As Integer

If Target.Row >= 3 And Target.Row <= 7 And Target.Column >= 3 And Target.Column <= 14 Then
If ILIG_SELECT <> 0 And ICOL_SELECT <> 0 Then
' Range("C3:N7").Select
' Selection.Interior.ColorIndex = xlNone
Cells(ILIG_SELECT, ICOL_SELECT).Interior.ColorIndex = x1None
End If
ILIG_SELECT = Target.Row
ICOL_SELECT = Target.Column
Cells(ILIG_SELECT, ICOL_SELECT).Interior.ColorIndex = 3 'couleur rouge
Cells(8, 3) = Cells(2, ICOL_SELECT)
Cells(8, 6) = Cells(ILIG_SELECT, 2)
End If

End Sub


D'autre part, j'ai une macro qui va chercher des données pour les copier dans d'autres cellules. Cette macro est située dans un module et elle fonctionne aussi très bien toute seule, même si elle n'est sans doute pas très élégante.

Sub DetailParcours()

With Sheets("Collecte des données")
Dim Tor1
Tor1 = .Range("W78").Text
Dim Tor2
Tor2 = .Range("W79").Text
Dim Tor3
Tor3 = .Range("W80").Text
Dim Tor4
Tor4 = .Range("W81").Text
Dim Lie1
Lie1 = .Range("W86").Text
Dim Lie2
Lie2 = .Range("W87").Text
Dim Lie3
Lie3 = .Range("W88").Text
Dim Lie4
Lie4 = .Range("W89").Text
If Sheets("Feuille de parcours").Range("Q43") Then
Dim Tor5
Tor5 = .Range("W82").Text
Dim Lie5
Lie5 = .Range("W90").Text
End If
End With

Sheets("Feuille de parcours").Unprotect

Sheets("Parcours").Range(Tor1).Copy Destination:=Range("R13")
Sheets("Parcours").Range(Tor2).Copy Destination:=Range("R19")
Sheets("Parcours").Range(Tor3).Copy Destination:=Range("R25")
Sheets("Parcours").Range(Tor4).Copy Destination:=Range("R31")
Sheets("Parcours").Range(Lie1).Copy Destination:=Range("R15")
Sheets("Parcours").Range(Lie2).Copy Destination:=Range("R21")
Sheets("Parcours").Range(Lie3).Copy Destination:=Range("R27")
Sheets("Parcours").Range(Lie4).Copy Destination:=Range("R33")

If Range("Q43") Then

Sheets("Parcours").Range(Tor5).Copy Destination:=Range("R37")
Sheets("Parcours").Range(Lie5).Copy Destination:=Range("R39")

Else
Range("R37,R39").Clear
End If

Range("Q10").Select

ActiveSheet.Protect , userInterfaceOnly:=True, _
AllowFormattingCells:=True, AllowFormattingRows:=True

End Sub


Mon soucis vient du fait que je voudrais qu'après chaque nouvelle sélection, cette macro soit lançée. donc j'ai introduit un appel de la macro dans le premier code, et là ça coince. Le bazar part en boucle et je dois arrêter Excel par le gestionnaire de tâche pour mettre fin à cette boucle.

.....................
Cells(8, 6) = Cells(ILIG_SELECT, 2)
End If
DetailParcours

End Sub

J'ai aussi essayé de copier la macro complète à la place de l'appel DétailParcours, mais c'est pareil.

Quelqu'un saurait-il me dire d'où vient mon problème?
A voir également:

2 réponses

mic13710 Messages postés 1088 Date d'inscription samedi 26 novembre 2005 Statut Membre Dernière intervention 13 mai 2021 353
10 mars 2009 à 10:20
Bon, je m'auto réponds,

Il suffit de désactiver temporairement l'évènement qui provoquent la boucle à l'intérieur du Private sub_Worksheet.

L'instruction est la suivante:
...................
Cells(8, 6) = Cells(ILIG_SELECT, 2)
End If
Application.EnableEvents = False
DetailParcours
Application.EnableEvents = True

End Sub

C'est en fouillant sur le net que j'ai trouvé la soluce:
http://xcell05.free.fr/pages/prog/evenements.htm#Introduction

Merci à l'auteur de cet excellent site
0
mic13710 Messages postés 1088 Date d'inscription samedi 26 novembre 2005 Statut Membre Dernière intervention 13 mai 2021 353
10 mars 2009 à 13:04
Petit correctif qui a son importance:

...................
Cells(8, 6) = Cells(ILIG_SELECT, 2)

Application.EnableEvents = False
DetailParcours
Application.EnableEvents = True

End If

End Sub

Déplacement du" End If" après la deuxième macro pour qu'elle ne soit appelée que lorsque un changement de sélection a été détecté à l'intérieur de la zone.
Sans cela, la macro était lançée lorsque je cliquais n'importe où sur la feuille.
0