Bonjour à tous,
La présence de liens externes est un problème assez courant et assez très très sioux.
Il faut en général:
- faire une recherche dans l'ensemble du classeur pour un "[" ou un ".xl" (CTRL+F, et choisir de chercher sur tout le classeur)
- vérifier les noms : onglet Formules, Gestionnaire de noms
- vérifier les mises en forme conditionnelle : pour un prochain article.
- vérifier les validations
Voici donc une petite macro qui va permettre de parcourir l'ensemble des validations de données d'un classeur pour identifier celles qui pourraient contenir des liaisons externes.
Une fois la macro exécutée, une nouvelle feuille est ajoutée au fichier.
Vous noterez que j'utilise des variables tableaux pour stocker le résultat. Ça n'est pas nécessaire, mais cela accélère grandement l'exécution du code, donc c'est une bonne pratique au final, surtout si vous avez des dizaines de milliers de lignes.
Option Explicit
Sub TrouveLiensExternesValidation()
'Definition des variables
Dim rgeCell As Range
Dim sDvForm As String
Dim counter As Integer
Dim wksResult As Worksheet
Dim wks As Worksheet
Dim arrNomFeuille As Variant
Dim arrAdresseCellule As Variant
Dim arrFormule As Variant
ReDim arrNomFeuille(1 To 1) As Variant
ReDim arrAdresseCellule(1 To 1) As Variant
ReDim arrFormule(1 To 1) As Variant
Dim arrResult As Variant
Dim lRow As Long
Dim lRowResultat As Long
'masquer l'actualisation
Application.ScreenUpdating = False
'compteur
lRow = 1
'on boucle sur toutes les feuilles
For Each wks In ActiveWorkbook.Worksheets
wks.Visible = xlSheetVisible
'on boucle sur toutes les cellules de la feuille
For Each rgeCell In wks.UsedRange.Cells
'On reprend la formule
On Error Resume Next
sDvForm = ""
sDvForm = rgeCell.Validation.Formula1
On Error GoTo 0
'il y a plusieurs options. On peut tester la presence d'un "[" ou bien du ".xl"
If InStr(1, sDvForm, ".xl") > 0 Then 'on trouve un ".xl"
lRow = lRow + 1
'on peut faire un Preserve, car une seule dimension dans le tableau
ReDim Preserve arrNomFeuille(1 To lRow) As Variant
ReDim Preserve arrAdresseCellule(1 To lRow) As Variant
ReDim Preserve arrFormule(1 To lRow) As Variant
'on stocke les donnees
arrNomFeuille(lRow) = wks.Name
arrAdresseCellule(lRow) = rgeCell.Address
arrFormule(lRow) = "'" & sDvForm
End If
Next rgeCell
Next wks
'on rapatrie les resultats dans la feuille
'On revient en A1
If lRow <> 0 Then
'creer la feuille de resultat
Set wksResult = ActiveWorkbook.Sheets.Add(before:=ThisWorkbook.Sheets(1))
'wksResult.Name = "external links"
ReDim arrResult(1 To lRow, 1 To 3) As Variant
arrResult(1, 1) = "Nom de la feuille"
arrResult(1, 2) = "Adresse de la cellule"
arrResult(1, 3) = "Formule"
For lRowResultat = 2 To UBound(arrNomFeuille, 1)
arrResult(lRowResultat, 1) = arrNomFeuille(lRowResultat)
arrResult(lRowResultat, 2) = arrAdresseCellule(lRowResultat)
arrResult(lRowResultat, 3) = arrFormule(lRowResultat)
Next lRowResultat
wksResult.Range("A1:C" & UBound(arrResult, 1)).Value = arrResult
End If
Application.ScreenUpdating = True
End Sub
Source d'inspiration : http://dailydoseofexcel.com/archives/2009/05/04/finding-external-links-in-data-validation/#comment-1045713
PS : Ne manquez aucune nouvelle astuce sur Excel, abonnez-vous à notre newsletter gratuite !