Lien hypertexte

mounish0 Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
mounish0 - 30 août 2013 à 12:13

Bonjour à tous,

Je travaille sur un fichier excel dans lequel figure approximativement 2000 liens hypertextes vers d'autres fichiers excel.

Malheureusement mon pc a fait une mise à jour avec mon fichier excel ouvert. De ce fait, je me retrouve avec des liens hypertextes qui ne marchent plus.

Le chemin suivant "..\..\..\AppData\Roaming\Microsoft\" s'est rajouté sur tous mes liens hypertextes.

Du coup, pour un lien hypertexte devant être comme cela auparavant "Excel\fiches_de_lecture\LA%20010867.xls", je me retrouve avec le lien suivant "..\..\..\AppData\Roaming\Microsoft\Excel\fiches_de_lecture\LA%20010867.xls"

J'ai donc essayé d'écrire un vba pour enlever la partie du lien qui s'est ajouté sur tous mes liens hypertextes mais je n'arrive pas à le faire marcher.

Voici mon code :

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15

Dim machaine As String
Dim i As Integer

machaine = ""
i = 0

For i = 5 To 3000

machaine = Cells(i, 15).Hyperlinks(1).adress

If machaine <> "" And Left(machaine, 41) = "../../../AppData/Roaming/Microsoft/Excel/" Then Cells(i, 15).Hyperlinks(1).adress = "" + Right(machaine, Len(machaine) - 41)

End If

Next i

End Sub

Si quelqu'un à une solution, cela pourrait m'être d'une grande aide.

En vous remerciant.

Mounish

Afficher la suite

A voir également:

Lien hypertexte
Lien url - Guide
Créer un lien pour partager des photos - Guide
Renommer un lien hypertexte ✓ - Forum Bugs et suggestions
Lien copié ✓ - Forum Google Chrome
Comment renommer un lien hypertexte - Forum Word

6 réponses

Réponse 1 / 6

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut,

Pas de grosses erreurs, tu étais plutôt bien parti.

1- Address prends deux d, et deux s (à la place de adress)
2- Dans ton test If, il y a deux syntaxe différentes. Si tu va à la ligne après le "Then", il faut un "End If", sinon il n'en faut pas :

If Machin = Bidule Then Truc = Machin

Ou :
If Machin = Bidule Then
    Truc = Machin
End If

Donc ton code devient :

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15

Dim machaine As String
Dim i As Integer


machaine = ""
i = 0
For i = 5 To 3000
    machaine = Cells(i, 15).Hyperlinks(1).Address
    If machaine <> "" And Left(machaine, 41) = "../../../AppData/Roaming/Microsoft/Excel/" Then Cells(i, 15).Hyperlinks(1).Address = Right(machaine, Len(machaine) - 41)
Next i
End Sub

Cordialement,
Franck

Réponse 2 / 6

mounish0 Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Merci pour cette correction et les informations.

J'ai copié/collé ton code et à l'exécution de la macro et malheureusement j'ai le message d'erreur suivant :

"L'indice n'appartient pas à la sélection"

La ligne de code suivante est surlignée :

machaine = Cells(i, 15).Hyperlinks(1).Address

Est-ce que tu aurais encore un petit coup de pouce à me donner?!!

Merci d'avance.

Mounish

Réponse 3 / 6

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

De rien!

Effectivement, je suis parti du principe que chacune des cellules sur lesquelles tu effectues ta boucle contient un lien. S'il n'y en a pas, ça buggue.
Pour éviter ce bug, tu peux utiliser cette fonction (trouvée ICI) qui renvoie l'adresse du lien, s'il y en a un...

Function AdresseHyperLien(ARange As Range, Feuille As Worksheet) As String
Dim h

AdresseHyperLien = ""
For Each h In Feuille.Hyperlinks
    If h.Range = ARange Then
        AdresseHyperLien = h.Address
        Exit For
    End If
Next
End Function

Ce qui change le code donné précédemment en :

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15

Dim machaine As String
Dim i As Integer

machaine = ""
For i = 5 To 3000
    machaine = AdresseHyperLien(Sheets("Feuil2").Range("O" & i), Sheets("Feuil2"))
    If machaine <> "" And Left(machaine, 41) = "../../../AppData/Roaming/Microsoft/Excel/" Then Cells(i, 15).Hyperlinks(1).Address = Right(machaine, Len(machaine) - 41)
Next i
End Sub

!!! ADAPTE le nom de ta feuille, en gras dans le code

Réponse 4 / 6

mounish0 Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Bonjour,

Quand un problème s'enlève, un autre arrive;

J'ai bien mis le code en remplaçant aux deux endroits le nom de ma feuille qui s'appelle "tous" et voilà la nouvelle erreur...

Sub ou Function non définie avec : "AdresseHyperLien" de surligné dans la ligne de code :

machaine = AdresseHyperLien(Sheets("tous").Range("O" & i), Sheets("tous"))

Aurais-tu encore une solution Franck??

Merci.

Mounish

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

As tu ajouté, sous ton code, après End Sub, la fonction :

Function AdresseHyperLien(ARange As Range, Feuille As Worksheet) As String
Dim h

AdresseHyperLien = ""
For Each h In Feuille.Hyperlinks
    If h.Range = ARange Then
        AdresseHyperLien = h.Address
        Exit For
    End If
Next
End Function

mounish0 Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Je n'avais pas ajouté de fonction sous end sub. Du coup, après ajout de ton code sous end sub.

Voilà la nouvelle erreur : incompatibilité de type pour la ligne de code

If h.Range = ARange Then

Est-ce normal que le derrière le "Dim h", il n'y ait rien??

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Sans voir ton fichier, on peut jouer aux devinettes longtemps...

Peux tu nous passer une copie, sans données confidentielles, en utilisant https://www.cjoint.com/

mounish0 Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Oui en effet, voici le lien vers le fichier;

https://www.cjoint.com/?0HxpaqakirY

Merci

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

chez moi, avec ton fichier, aucun bug à déplorer...

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut,

On va donc changer de fonction, pour une plus simple :

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15 dans la feuille "tous"

Dim machaine As String
Dim i As Integer


machaine = ""
For i = 5 To 3000
    machaine = EstHyperLien(Sheets("tous").Range("O" & i))
    If machaine <> "" And Left(machaine, 41) = "../../../AppData/Roaming/Microsoft/Excel/" Then Cells(i, 15).Hyperlinks(1).Address = Right(machaine, Len(machaine) - 41)
Next i
End Sub

Function EstHyperLien(ARange As Range) As Boolean
 
EstHyperLien = False
If ARange.Hyperlinks.Count = 1 Then EstHyperLien = True
End Function

Réponse 6 / 6

mounish0

Merci pour le temps que tu passes à m'aider Franck.

Je viens de mettre le nouveau code, pas e bug mais les liens ne changent toujours pas...

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Oui, stupide erreur de ma part. J'ai omis de modifier le code de la Sub;..
Essaie ceci :

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15 dans la feuille "tous"

Dim machaine As String
Dim i As Integer

machaine = ""
For i = 5 To 3000
    If EstHyperLien(Sheets("tous").Range("O" & i)) = True Then machaine = Cells(i, 15).Hyperlinks(1).Address
    If machaine <> "" And Left(machaine, 41) = "../../../AppData/Roaming/Microsoft/Excel/" Then Cells(i, 15).Hyperlinks(1).Address = Right(machaine, Len(machaine) - 41)
Next i
End Sub

Function EstHyperLien(ARange As Range) As Boolean
 
EstHyperLien = False
If ARange.Hyperlinks.Count = 1 Then EstHyperLien = True
End Function

mounish0

Salut,

Un peu de changement cette fois-ci, j'ai un bug au niveau de ce bout de code :

Cells(i, 15).Hyperlinks(1).Address = Right(machaine, Len(machaine) - 41)

Mounish

mounish0

Rebonjour,

Je viens de me repencher sur le code et je n'avais pas fait attention que je n'avais pas écrit tout le lien hypertexte en entier.

Au lieu des ..\..\, il y avait en fait une adresse plus complexe :

///C:\Users\Clement\AppData\Roaming\Microsoft\Excel\

Du coup, j'ai modifier la ligne ci dessous :

If machaine <> "" And Left(machaine, 52) = "///C:\Users\Clement\AppData\Roaming\Microsoft\Excel\" Then Cells(i, 15).Hyperlinks(1).Address = Replace(machaine, "///C:\Users\Clement\AppData\Roaming\Microsoft\Excel\", "///C:\Users\Clement\Documents\réglementation\veille\")

De ce fait, je n'ai plus de bug mais mes liens ne changent toujours pas...

Voici le code à jour

Sub Modif_lien()

' Modif_lien Macro dans la colonne numéro 15 dans la feuille "tous"

Dim machaine As String
Dim i As Integer

machaine = ""
machaine2 = ""
For i = 5 To 3000
If EstHyperLien(Sheets("tous").Range("O" & i)) = True Then machaine = Cells(i, 15).Hyperlinks(1).Address
If machaine <> "" And Left(machaine, 52) = "///C:\Users\Clement\AppData\Roaming\Microsoft\Excel\" Then Cells(i, 15).Hyperlinks(1).Address = Replace(machaine, "///C:\Users\Clement\AppData\Roaming\Microsoft\Excel\", "///C:\Users\Clement\Documents\réglementation\veille\")

' C:\Users\ClementDocuments\réglementation\veille\fiches_de_lecture\D...
Next i
End Sub

Function EstHyperLien(ARange As Range) As Boolean

EstHyperLien = False
If ARange.Hyperlinks.Count = 1 Then EstHyperLien = True
End Function

Mounish

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut,

Le code fonctionne, est valide, et fait ce qui est demandé. Maintenant, il te faut vérifier si les liens écrits dans ta colonne O correspondent bien "textuellement parlant"...

mounish0

Tous mes liens sont modifiés avec le code qui marche.

Je remercie pour tes explications et le temps consacré!!!!

Mounish

Discussions similaires

Copier un lien instagram

renommer un lien internet

comment changer le nom d'un lien?

Retrouver liens copiés sur le téléphone

Rajout de lien sur plusieurs pages

Votre réponse

Discussions similaires