Sujet Précédent Sujet Suivant

Lien hypertexte

Fermé
mounish0 Messages postés 5 Date d'inscription mercredi 21 août 2013 Statut Membre Dernière intervention 23 août 2013 - 21 août 2013 à 18:50
 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

6 réponses

Réponse 1 / 6
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
Modifié par pijaku le 22/08/2013 à 09:28
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
Réponse 2 / 6
mounish0 Messages postés 5 Date d'inscription mercredi 21 août 2013 Statut Membre Dernière intervention 23 août 2013
22 août 2013 à 19:16
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
Réponse 3 / 6
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
23 août 2013 à 08:38
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
Réponse 4 / 6
mounish0 Messages postés 5 Date d'inscription mercredi 21 août 2013 Statut Membre Dernière intervention 23 août 2013
23 août 2013 à 09:25
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
23 août 2013 à 09:32
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
mounish0 Messages postés 5 Date d'inscription mercredi 21 août 2013 Statut Membre Dernière intervention 23 août 2013
23 août 2013 à 14:23
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
23 août 2013 à 14:52
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
mounish0 Messages postés 5 Date d'inscription mercredi 21 août 2013 Statut Membre Dernière intervention 23 août 2013
23 août 2013 à 15:01
Oui en effet, voici le lien vers le fichier;

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

Merci
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
23 août 2013 à 16:01
chez moi, avec ton fichier, aucun bug à déplorer...
0

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 jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
26 août 2013 à 14:23
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
Réponse 6 / 6
mounish0
27 août 2013 à 08:38
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
27 août 2013 à 08:42
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
mounish0
28 août 2013 à 08:37
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
mounish0
28 août 2013 à 10:29
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
28 août 2013 à 12:45
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
mounish0
30 août 2013 à 12:13
Tous mes liens sont modifiés avec le code qui marche.

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

Mounish
0

Discussions similaires

"Aucune application permettant d'ouvrir cette URL"
sidojaice -
JIP -

24 réponses
lien copié
alaurore -
LEFEUVRE -

7 réponses
Rajout de lien sur plusieurs pages
leparradiss -
David -

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

1 réponse
Insérer un lien hypertexte dans un post Linkedin
PhiL -
HeleneH -

7 réponses