Lien hypertexte

mounish0 Messages postés 5 Statut Membre -  
 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

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    0
  2. mounish0 Messages postés 5 Statut Membre
     
    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
    0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    0
  4. mounish0 Messages postés 5 Statut Membre
     
    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
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
      0
    2. mounish0 Messages postés 5 Statut Membre
       
      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??
      0
    3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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/
      0
    5. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      chez moi, avec ton fichier, aucun bug à déplorer...
      0

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

    Posez votre question
  6. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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

    0
  7. 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...
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
      0
    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
      0
    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
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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"...
      0
    5. mounish0
       
      Tous mes liens sont modifiés avec le code qui marche.

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

      Mounish
      0

Discussions similaires

Copier un lien instagram
alaurore -
LEFEUVRE -

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

2 réponses
renommer un lien internet
brian johnson -
pilou67000 -

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

17 réponses
copie d'un lien dans le navigateur internet
Ulysse Orseau -
diamantnoir -

4 réponses