Obtention des cellules qui comportent des liens vers d'autres classeurs en VBA

Sub ShowAllLinksInfo()
'Author:        JLLatham
'Purpose:       Identify which cells in which worksheets are using Linked Data
'Requirements:  requires a worksheet to be added to the workbook and named LinksList
'Modified From: [url=http://answers.microsoft.com/en-us/office/forum/office_2007-excel/workbook-links-cannot-be-updated/b8242469-ec57-e011-8dfc-68b599b31bf5?page=1&tm=1301177444768]Workbook links cannot be updated... - Microsoft Community[/url]
    Dim i%, nextReportRow&, shtName$, aLinks, anyCell  As Range
    Dim Ws               As Worksheet
    Dim anyWS            As Worksheet
    Dim reportWS         As Worksheet
    
    shtName = "LinksList"
 
    'Create the result sheet if one does not already exist
    For Each Ws In Application.Worksheets
        If Ws.Name = shtName Then bWsExists = True
    Next Ws
    If bWsExists = False Then
        Application.DisplayAlerts = False
        ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet).Name = shtName
        ActiveSheet.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        Application.DisplayAlerts = True
    End If
 
    'Now start looking of linked data cells
    Set reportWS = ThisWorkbook.Worksheets(shtName)
    reportWS.Cells.Clear
    reportWS.Range("A1:C1") = Array("Feuille", "Cellule", "Formule")
    
    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLinks) Then
        'there are links somewhere in the workbook
        For Each anyWS In ThisWorkbook.Worksheets
            If anyWS.Name <> reportWS.Name Then
                For Each anyCell In anyWS.UsedRange
                    If anyCell.HasFormula Then
                        If InStr(anyCell.Formula, "[") > 0 Then
                            nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                            reportWS.Range("A" & nextReportRow) = anyWS.Name
                            reportWS.Range("B" & nextReportRow) = anyCell.Address
                            reportWS.Range("C" & nextReportRow) = "'" & anyCell.Formula
                        End If
                    End If
                Next    ' end anyCell loop
            End If
        Next    ' end anyWS loop
    Else
        MsgBox "Aucune liaison détectée avec des classeurs externes.", vbCritical, "Informations"
    End If
    'housekeeping
    Set reportWS = Nothing
    Set Ws = Nothing
End Sub

Sub AdressesCellulesSansFormules()
'Variation de Staple1600 sur ShowAllLinksInfo (de JLLatham)
    Dim i%, nextReportRow&, shtName$, aLinks, anyCell  As Range
    Dim Ws               As Worksheet
    Dim anyWS            As Worksheet
    Dim reportWS         As Worksheet
    shtName = "RawDatas"
    'Create the result sheet if one does not already exist
    For Each Ws In Application.Worksheets
        If Ws.Name = shtName Then bWsExists = True
    Next Ws
    If bWsExists = False Then
        Application.DisplayAlerts = False
        ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet).Name = shtName
        ActiveSheet.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        Application.DisplayAlerts = True
    End If
 
    'Now start looking of linked data cells
    Set reportWS = ThisWorkbook.Worksheets(shtName)
    reportWS.Cells.Clear
    reportWS.Range("A1:B1") = Array("Feuille", "Cellule")
    
        For Each anyWS In ThisWorkbook.Worksheets
            If anyWS.Name <> reportWS.Name Then
            On Error Resume Next
                For Each anyCell In anyWS.UsedRange.SpecialCells(xlCellTypeConstants, 3)
                    If Len(anyCell) > 0 Then
                            nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                            reportWS.Range("A" & nextReportRow) = anyWS.Name
                            reportWS.Range("B" & nextReportRow) = anyCell.Address(0, 0)
                    End If
                Next    ' end anyCell loop
            End If
        Next    ' end anyWS loop
    'housekeeping
    Set reportWS = Nothing
    Set Ws = Nothing
End Sub

Sub testII()
Dim anyCell As Range, anyWS As Worksheet, RESULTS$
For Each anyWS In ThisWorkbook.Worksheets
For Each anyCell In anyWS.UsedRange.SpecialCells(xlCellTypeConstants, 3)
If Len(anyCell) > 0 Then
RESULTS = RESULTS & anyWS.Name & ": " & anyCell.Address(0, 0) & Chr(13)
End If
Next
Next
MsgBox Space(35) & Chr(13) & RESULTS, vbInformation, "Mauvaise idée, la MsgBox ;-)"
End Sub