IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Identifier les liens brisés avec VBA


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Avril 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Eure (Haute Normandie)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Avril 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut 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

  2. #2
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 203
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 203
    Points : 14 354
    Points
    14 354
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  3. #3
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Avril 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Eure (Haute Normandie)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Avril 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut
    Merci Daniel.

    Je vais tester ton code

Discussions similaires

  1. [XL-2007] Agir sur les options internet avec VBA
    Par lenovo49 dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 03/02/2012, 11h35
  2. Verrouiller tous les champs texte avec VBA
    Par Lincoln911 dans le forum VBA Access
    Réponses: 6
    Dernier message: 19/04/2010, 15h24
  3. [Dreamweaver] [FAQ] Vérifier les liens brisés d'un site
    Par beegees dans le forum Contribuez
    Réponses: 2
    Dernier message: 18/02/2010, 15h12
  4. [XL-2003] Comment identifier les shape ovale en VBA
    Par vbfoxter dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 27/11/2009, 10h21
  5. lien internet avec VBA EXCEL
    Par casefayere dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 19/07/2007, 10h40

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo