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