Discussion :

[Poye_]

Bonsoir,

Je dois développer une marco qui, à partir d'une sélection de cellules, doit déterminer leurs dépendants et afficher les résultats dans une nouvelle feuille.

Jusque là, pas de souci. Le seul problème, c'est que j'aimerais développer ce programme afin d'avoir tous les dépendants de la cellule - même si ils sont sur une feuille autre que celle de ma cellule sélectionnée. Or, la fonction Dependents ne tient compte que des dépendants su la même feuille.

Ma question est donc:
Y a-t-il un moyen d'atteindre les dépendants d'une cellule sur tout le classeur ?

Merci d'avance.

[ilcocodrillo]

Dependents, propriété
Voir aussi S'applique à Exemple Spécificités
Cette propriété renvoie un objet Range qui représente la plage contenant tous les dépendants d'une cellule. Il peut s'agir d'une sélection multiple (une union d'objets Range) s'il existe plusieurs dépendants. Objet Range en lecture seule.

expression.Dependents

expression Obligatoire. Expression qui renvoie un des objets répertoriés dans la liste S'applique à.

Note
Remarque La propriété Dependents fonctionne uniquement sur la feuille active et ne peut pas suivre les références distantes.

Exemple
Cet exemple montre comment sélectionner les dépendants de la cellule A1 de la feuille Sheet1.

Code :

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

1
2
Worksheets("Sheet1").Activate
Range("A1").Dependents.Select

Voilà qui répond à ta question de façon explicite.

[Poye_]

Ce qui veut dire que mon programme est impossible à réaliser ?

[SilkyRoad]

bonjour

Une deuxième version complètée, à tester:

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
172
173
174
175
176
Option Explicit
 
Sub Test()
    'Liste les dépendants de la cellule D4, dans la Feuil2
    ListeDependents Worksheets("Feuil2").Range("D4")
End Sub
 
 
Sub ListeDependents(Cellule As Range)
    Dim Ws As Worksheet
    Dim Plage As Range, Cell As Range, DirectDep As Range
    Dim i As Integer, x As Integer
    Dim Cible As String, strDepenDent As String, strRefer As String
    'La liste des dépendants  va être stockée dans une collection
    Dim Un As New Collection
 
 
    'Active la feuille contenant la cellule à contrôler
    Cellule.Parent.Activate
 
    strDepenDent = Cellule.Parent.Name & "!" & Cellule.Address(0, 0)
 
 
    'Vérifie s'il y a des dépendants directs dans la feuille:
    On Error Resume Next
    'Définit la plage de cellules dépendantes, dans la feuille active
    Set Plage = Cellule.DirectDependents.Cells
    On Error GoTo 0
 
    If Not Plage Is Nothing Then
        'Boucle sur les dépendants contenus dans la feuille active
        For Each DirectDep In Cellule.DirectDependents.Cells
            Un.Add Cellule.Parent.Name & "!" & DirectDep.Address, _
                Cellule.Parent.Name & "!" & DirectDep.Address
        Next DirectDep
    End If
 
    Set Plage = Nothing
 
 
 
    'Boucle sur les autres feuilles du classeur:
    For Each Ws In ThisWorkbook.Worksheets
        'Si la feuille est différente de la feuille active
        If Ws.Name <> Cellule.Parent.Name Then
 
            On Error Resume Next
            'Définit la plage de cellules contenant des formules
            Set Plage = Ws.UsedRange.SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
 
 
            'Vérifie si la feuille contient des formules
            If Not Plage Is Nothing Then
 
                'Boucle sur les cellules contenant des formules
                For Each Cell In Plage
 
                    'Gestion des références relatives et absolues
                    Cible = Replace(Cell.Formula, "$", "")
 
 
                    'Vérifie si le nom de la feuille apparait dans la formule.
                    If InStr(1, Cible, Cellule.Parent.Name) > 0 Then
 
                        'Vérifie si la formule contient une référence correspondant à la
                        'cellule à contrôler
                        i = 0
                        i = InStr(1, Cible, strDepenDent)
 
                        'Si la référence est trouvée on l'intègre dans la collection
                        If i > 0 And Not IsNumeric(Mid(Cible, i + Len(strDepenDent), 1)) Then
 
                            Un.Add Ws.Name & "!" & Cell.Address, Ws.Name & "!" & Cell.Address
 
                        Else
 
                            'Recherche des références dans les plages de cellules
                            For x = 1 To Len(Cible)
                                i = 0
                                i = InStr(1, Cible, ":")
 
                                If i > 0 Then
                                    strRefer = ExtractionReferences(Cible)
 
                                    'Si la cellule à contrôler se trouve dans la plage,
                                    'on l'intègre dans la collection.
                                    If VerifIntersect(Cellule, Range(strRefer)) And _
                                        InStr(1, Cible, Cellule.Parent.Name & "!" & strRefer) > 0 Then
 
                                        On Error Resume Next
                                        Un.Add Ws.Name & "!" & Cell.Address, Ws.Name & "!" & Cell.Address
                                        On Error GoTo 0
 
                                        Exit For
                                    End If
 
                                    Cible = Mid(Cible, i + 1)
                                Else
                                    Exit For
                                End If
                            Next x
                            '--------------
 
 
                        End If
                    End If
                Next Cell
 
            End If
        End If
 
        Set Plage = Nothing
    Next Ws
 
 
    'Boucle sur la collection qui contient la liste des dépendants
    For i = 1 To Un.Count
        'Affiche le résultat dans la fenêtre d'exécution (Ctrl+G)
        Debug.Print Un.Item(i)
    Next i
End Sub
 
 
 
 
'Extrait les références spécifiées dans les formules
Function ExtractionReferences(Chaine As String) As String
    Dim i As Integer, j As Integer
    Dim strPlage As String, Caract As String
 
    i = InStr(1, Chaine, ":")
 
 
    'Renvoie la référence avant les deux points ":"
    For j = i - 1 To 1 Step -1
        Caract = Mid(Chaine, j, 1)
 
        Select Case Asc(Caract)
            Case 48 To 57, 65 To 90, 97 To 122
            strPlage = Caract & strPlage
            Case Else: Exit For
        End Select
    Next j
 
    strPlage = strPlage & ":"
 
    'Renvoie la référence après les deux points ":"
    For j = i + 1 To Len(Chaine)
        Caract = Mid(Chaine, j, 1)
 
        Select Case Asc(Caract)
            Case 48 To 57, 65 To 90, 97 To 122
            strPlage = strPlage & Caract
            Case Else: Exit For
        End Select
    Next j
 
    ExtractionReferences = strPlage
End Function
 
 
 
'Vérifie si la référence extraite dans la formule a une intersection
'avec la cellule dont on contrôle les dépendances.
Function VerifIntersect(objDepend As Range, objReference As Range) As Boolean
    Dim objRange As Range
 
    Set objRange = Intersect(objDepend, objReference)
 
    If objRange Is Nothing Then
        VerifIntersect = False
        Else
        VerifIntersect = True
    End If
End Function

michel

[EDIT] mise à jour à 11:26

[Dédé6621]

Bonjour,

Une deuxième version complètée, à tester:

J'ai testé et ça marche , moyennant quelques adaptations :

À la ligne 81:

Code :

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

1
2
3
4
5
6
'Ajout perso pour ignorer les formules qui font référence à des classeurs externes
If Not Left(Cible, 4) Like "='[A-Z]:" Then
    i = InStr(1, Cible, ":")
Else
    Exit For
End If

Et une gestion des erreurs pour les plages de cellules répétant le nom de la feuille, par exemple Feuil1!A1:Feuil1!A50 (ça arrive...).
strRefer serait alors A1:Feuil1 au lieu de A1:A50
Je n'ai pas cherché à corriger ça.

Amicalement