XL 2021 VBA - Visualiser les références circulaires

Sub test()
    Dim X
    X = GetCircularReference
    MsgBox Join(X, vbCrLf)
End Sub
Function GetCircularReference() As Variant
    'fonction patricktoulon
    'Recherche de ref circulaire et listage dans un tableau excel 2003 a excel 2024
    Dim circs As Range, refs As Collection, fml As String, cell As Range, memoire As Object
    With Application: .ScreenUpdating = False: .Calculation = xlCalculationManual: .CalculateFullRebuild: End With
    Set memoire = CreateObject("Scripting.Dictionary")
    Set refs = New Collection
    Do
        Set circs = ActiveSheet.CircularReference 'on capte la première
        If circs Is Nothing Then Exit Do 'on sort il y en a pas
        ' Mémorise la formule et l’adresse
        If Not memoire.Exists(circs.Address(External:=True)) Then
            refs.Add circs.Address(External:=True) 'si elle n'existe pas on l'ajoute a la collection
            memoire(circs.Address(External:=True)) = circs.Formula 'et on memorise dans le dico address/ref circulaire pour les remttre après
        End If
        circs.Formula = "'" & circs.Formula ' on commente la formule pour quelle ne soit pas trouvée au prochain tour
        Application.Calculate 'on calculate pour  pour que la feuille soit a jour en terme d'absence ou presence de ref circulaire
    Loop 'et on tourne  il prendra la suivante
    ' on remet le formules c'est pas compliqué a comprendre
    For Each cell In ActiveSheet.UsedRange
        If memoire.Exists(cell.Address(External:=True)) Then cell.Formula = memoire(cell.Address(External:=True))
    Next
    'on debloque tout
    With Application: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With
    ' si y a pas bye bye!!
    If refs.Count = 0 Then
        MsgBox "Aucune référence circulaire.", vbInformation
    Else
        'sinon on compile les addresse de refs circulaire
        ReDim tbl(1 To refs.Count)
        For i = 1 To refs.Count
            tbl(i) = refs(i)
        Next i
        GetCircularReference = tbl
    End If
End Function

Sub test()
    Dim X
    X = GetCircularReference
    MsgBox Join(X, vbCrLf)
End Sub


Function GetCircularReference() As Variant
    'fonction patricktoulon
    'Recherche de ref circulaire et listage dans un tableau excel 2003 a excel 2024
    Dim circs As Range, refs As Collection, fml As String, cell As Range, memoire As Object
    
    With Application: .ScreenUpdating = False: .Calculation = xlCalculationManual: .CalculateFullRebuild: End With
    
    Set memoire = CreateObject("Scripting.Dictionary")
    
    Set refs = New Collection
    
    Do
        'ActiveSheet.CircularReference donne TOUJOURS !! la premiere  ref circulaire
     ' donc je la demande
    
     Set circs = ActiveSheet.CircularReference 'on capte la première
        
        If circs Is Nothing Then Exit Do 'SI!!! il y en a pas ou !! plus on sort
        
        ' Mémorise la formule et l’adresse
        If Not memoire.Exists(circs.Address(External:=True)) Then 'si dans le dico elle existe pas
            
            refs.Add circs.Address(External:=True) 'si elle n'existe pas on l'ajoute a la collection
            
            memoire(circs.Address(External:=True)) = circs.Formula 'et on memorise dans le dico address/ref circulaire pour les remttre après
        
        End If
        
        '**********************************************
        'IMPORTANT A COMPRENDRE
        ' ICI ON COMMENTE LA FORMULE POUR LA BLOQUER
        ' sinon au prochain tours il me redonne la même puisque CircularReference me donne toujours la premiere
        ' et c'est normal puisque dans ce cas normalement tu a un message excel qui arrête forcement le calculate quand il calcule une ref circulaire
        'donc ca va pas plus loin que la première
        circs.Formula = "'" & circs.Formula ' on commente la formule pour quelle ne soit pas trouvée au prochain tour
        '*********************************************
        
        'ici on calculate mano mano pour faire comprendre dans le stack excel que la cellule n'a plus la formule avec ref circulaire
        Application.Calculate 'on calculate pour  pour que la feuille soit a jour en terme d'absence ou presence de ref circulaire
    Loop 'et on tourne  donc il prendra forcement la suivante au prochain tour
    
    'voila le petit tour est fini  on apasser en revues toutes les refs circulaires on les a stoké
    
    ' ben maintenant on les remet les formules pour revenir a l'initiale
    For Each cell In ActiveSheet.UsedRange
        
        If memoire.Exists(cell.Address(External:=True)) Then cell.Formula = memoire(cell.Address(External:=True))
    
    Next
    
    'on debloque tout ca tu connais
    With Application: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With
    
    ' si y a pas ben ...bye bye!!
    If refs.Count = 0 Then
        
        MsgBox "Aucune référence circulaire.", vbInformation
    
    Else
        
        'sinon on compile les addresse de refs circulaire on les transfert de la collects vers un tableau variant()
        ReDim tbl(1 To refs.Count)
        For i = 1 To refs.Count
            tbl(i) = refs(i)
        Next i
        GetCircularReference = tbl
    End If
End Function