Problème de boucle sur programmation VBA
Résolu
mic13710
Messages postés
1087
Date d'inscription
Statut
Membre
Dernière intervention
-
mic13710 Messages postés 1087 Date d'inscription Statut Membre Dernière intervention -
mic13710 Messages postés 1087 Date d'inscription Statut Membre Dernière intervention -
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?
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:
- Problème de boucle sur programmation VBA
- Application de programmation - Guide
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum Excel
- Dépassement de capacité vba ✓ - Forum Excel
- Vba attendre 1 seconde ✓ - Forum VB / VBA
2 réponses
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
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
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.
...................
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.