Test et liste de tous les fichiers hypertextes d'un classeur excel

Question

Bonjour à tous,

Je suis tout nouveau sur le forum et je pense que je n'ai pas du poster dans le bon thèmes. Je suis complètements débutant sur Excel en Macro je ne me contente que de transposer des codes que j'ai trouvé sur différent en essayant de les adapter avec plus ou moins de succès. 

Je vous expose mon soucis, je possède Excel 2010 avec un fichier qui contient de nombreux liens hypertextes vers d'autres fichier ou dans différents onglet du même classeur. Je voudrais ajouter une macro me permettant de vérifier si mes liens sont toujours "bon" et ne renvoie pas une erreur (dû principalement à un fichier renommé ou déplacé) et que les liens qui sont "mort" soit indiqué pour que je les modifies (dans un nouvelle onglet si possible).

Voilà j'ai vu des conversation où ce problème était déjà poser mais je n'ai pas réussi à réutiliser le code. 

Si quelqu'un pouvait m'aider je lui serais très reconnaissant.

Merci d'avance. Je suis à votre disposition pour répondre à vos questions.

cs_Le Pivert · Answer

Bonjour,
Voici un code qui te permet de parcourir tous les liens avec arrêt si tu le désires:
à mettre dans un bouton dans une UserForm

Option Explicit
Private Sub CommandButton1_Click()
Rechercheliens
End Sub
Sub Rechercheliens()
Dim Lien, Response
For Each Lien In Sheets("Feuil1").Hyperlinks 'changer la feuille si besoin "Feuil12" etc.
 Lien.Range.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
' Affiche le message.
Response = MsgBox("Souhaitez-vous continuer?", vbYesNo + vbInformation + vbDefaultButton2, "Recherche liens hypertextes")
If Response = vbYes Then    ' L'utilisateur a choisi Oui.
   'on continue
Else    ' L'utilisateur a choisi Non.
  Exit Sub 'on quitte ou le code pour changer le lien
End If
Next
End Sub


Si le lien est rompu tu vas avoir une erreur, cela sera facile pour toi de la corriger
@+Le Pivert

MatQHSE · Answer

Je te remercie cela marche et j'ai réussi à l'utiliser. Par contre je dois tester tous les liens un par un et je possède des feuilles pouvant contenir plus de 60 liens donc je voulais savoir s'il était possible que Excel vérifie lui même l'onglet(le top serait qu'il vérifie tous les onglets de la feuille (le fichier comporte plus de 15 onglets)) et qu'il m'indique (dans une nouvelle feuille ou n'importe comment la ou les cellules (ainsi que l'onglet)) dont le lien n'est pas bon.

En tout cas je te remercie Monsieur Le Pivert pour cette première réponse si rapide.

cs_Le Pivert · Answer

Je ne vois pas. Par contre pour te faciliter la tâche tu mets la propriété ShowModal à False de ton UserForm pour pouvoir travailler sur ta feuille. Tu ajoutes aussi dans ton code:  
Sub Rechercheliens()
Dim Lien, Response
On Resume Next


Ce qui arretera la boucle à chaque lien rompu. Tu pourras le réparer.
La seule chose que l'on peut faire c'est une boucle sur tous tes onglets. Mais cela ne t'empêcheras pas les corrections manuelles.
Le Pivert

MatQHSE · Answer

Je te remercie pour tes réponse je vais utiliser cette méthode je vois pas trop comment je pourrais faire autrement.

J'aurais une autre question, je ne sais pas si cela est possible. Mais est ce qu'une maccro me permettrait d'afficher dans un nouvelle onglet le chemin d'accès  de tous les liens que contient un onglet ce qui me permettrait de mettre à jour les chemins si je renomme un dossier?

Encore merci de ta disponibilité le pivert.

cs_Le Pivert · Answer

Voici le code avec les commentaires pour comprendre ce qui a été fait. Sinon copier coller sans comprendre cela ne sert à rien!
Tu auras juste à changer le nom des feuilles:

Option Explicit
Dim Lien, Response, ligne
Private Sub CommandButton1_Click()
Rechercheliens
End Sub
Sub Rechercheliens()
On Error Resume Next 'arrete en cas de lien rompu
For Each Lien In Sheets("Feuil1").Hyperlinks 'changer la feuille si besoin
 Lien.Range.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
 Selection.Copy
    Sheets("Feuil2").Select 'changer la feuille si besoin
    dernierligne
     Range("A" & ligne).Select
       ActiveCell.Offset(1, 0).Select  'sélection cellule suivante colonne A(1 ligne suivante, 0 même colonne)
    ActiveSheet.Paste
    Sheets("Feuil1").Select 'on retourne à la feuille des liens changer la feuille si besoin
' Affiche le message.
Response = MsgBox("Souhaitez-vous continuer?", vbYesNo + vbInformation + vbDefaultButton2, "Recherche liens hypertextes")
If Response = vbYes Then    ' L'utilisateur a choisi Oui.
   'on continue
Else    ' L'utilisateur a choisi Non.
  Exit Sub 'on quitte
End If
Next
End Sub
'Chercher la dernière ligne de la colonne A et de la feuil2
Function LastRow()
'feuille active, colonne A
  LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
End Function
Sub dernierligne()
ligne = LastRow
End Sub


Le Pivert

MatQHSE · Answer

Merci le pivert de ton aide. Je vais utiliser cette méthode, je ferais des contrôles hebdomadaire je pense que cela suffira. Encore merci de ta disponibilité.

cs_Le Pivert · Answer

J'attendais ta réponse. Voici une macro qui parcourt toutes les feuilles en copiant tous les liens:

Sub Copierliens()
Dim i
For i = 1 To Worksheets.Count - 1
For Each Lien In Sheets(i).Hyperlinks
Sheets(i).Select
 Lien.Range.Select
 Selection.Copy
    Sheets("Feuil4").Select 'changer la feuille si besoin
    dernierligne
    Range("A" & ligne).Select
    ActiveCell.Offset(1, 0).Select  'sélection cellule suivante colonne A(1 ligne suivante, 0 même colonne)
    ActiveSheet.Paste
   Next
Next
 Sheets("Feuil4").Select 'changer la feuille si besoin
 If Range("A1") = "" Then
 Range("A1").Delete
 End If
End Sub

Si cela peut-être utile?
@+Le Pivert

Test et liste de tous les fichiers hypertextes d'un classeur excel

7 réponses

Votre réponse

Discussions similaires