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
| Sub ListeEtatLiaisons()
Dim txt As String, aLinks, Ligne As Long, Result As String
Sheets.Add
aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
txt = aLinks(i)
Result = GetLinkStatus(txt)
Ligne = Ligne + 1
Cells(Ligne, 1) = txt
Cells(Ligne, 2) = Result
Next i
End If
Range("A:B").EntireColumn.AutoFit
End Sub
Function GetLinkStatus(sLink As String) As String
Dim avLinks As Variant
Dim nIndex As Integer
Dim sResult As String
Dim nStatus As Integer
avLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If IsEmpty(avLinks) Then
GetLinkStatus = "No links in workbook."
Exit Function
End If
For nIndex = 1 To UBound(avLinks)
If StrComp(avLinks(nIndex), sLink, vbTextCompare) = 0 Then
nStatus = ActiveWorkbook.LinkInfo(sLink, xlLinkInfoStatus)
Select Case nStatus
Case xlLinkStatusCopiedValues
sResult = "Copied values"
Case xlLinkStatusIndeterminate
sResult = "Indeterminate"
Case xlLinkStatusInvalidName
sResult = "Invalid name"
Case xlLinkStatusMissingFile
sResult = "Missing file"
Case xlLinkStatusMissingSheet
sResult = "Missing sheet"
Case xlLinkStatusNotStarted
sResult = "Not started"
Case xlLinkStatusOK
sResult = "OK"
Case xlLinkStatusOld
sResult = "Old"
Case xlLinkStatusSourceNotCalculated
sResult = "Source not calculated"
Case xlLinkStatusSourceNotOpen
sResult = "Source not open"
Case xlLinkStatusSourceOpen
sResult = "Source open"
Case Else
sResult = "Unknown status code"
End Select
Exit For
End If
Next
GetLinkStatus = sResult
End Function |
Partager