Identifier les liens brisés avec VBA

Bonjour,

Je cherche le moyen d'identifier via macro VBA les liens morts (ou brisés) se trouvant dans un fichier Excel ou PowerPoint.

Pouvez-vous m'orienter.

D'avance merci

Bonjour,

Désolé pour les messages en anglais. Si ça te pose un problème, je te les traduirai. La macro ajoute une feuille au classeur à étudier et liste l'état des liaisons :

Code:

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

Merci Daniel.

Je vais tester ton code