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.
A voir également:
Test et liste de tous les fichiers hypertextes d'un classeur excel
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
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.
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
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?
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
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é.
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
