Lien hypertexte

mounish0 -  
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

6 réponses

  • Votes
  • Date
  • Date décroissante
  1. pijaku Modérateur
    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
    1. mounish0 Auteur
      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
      1. pijaku Modérateur
        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
        1. mounish0 Auteur
          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
          1. pijaku Modérateur
            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
          2. mounish0 Auteur
            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??
          3. pijaku Modérateur
            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/
          5. pijaku Modérateur
            chez moi, avec ton fichier, aucun bug à déplorer...
        3. pijaku Modérateur
          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

          1. 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...
            1. pijaku Modérateur
              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
            2. 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
            3. 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
            4. pijaku Modérateur
              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"...
            5. 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
          alaurore

          7 réponses
          Retrouver liens copiés sur le téléphone
          SAMA

          2 réponses
          copie d'un lien dans le navigateur internet
          Ulysse Orseau

          4 réponses
          renommer un lien internet
          brian johnson

          1 réponse
          comment changer le nom d'un lien?
          nina20

          17 réponses