Macro pour modifier des liens hypertextes (Résolu)

popcorn

XLDnaute Occasionnel
Bonjour,

Je débute vraiment avec les macros.Mon problème, c'est que j'ai des liens hypertextes pointer sur des photos qui n'ont plus le bon chemin d’accès, suite à des malheureux "copie/collé" sur le fichier.

Mon dossier se présente : Sociéte>Projet>Photo (dossier) + classeur xls (Fichier)

Déja dans un premier temps, je pense qu'il y a surement moyen de faire pointer les liens dans le dossier Photo en permanence même si celui ci est déplacé. Je crois que je suis mal partit.bref.

Du coup, j'ai tous mes liens à reprendre:
Avec la fonction rechercher/remplacer, cela ne fonctionne pas dans la boite des liens hypertextes.

J'ai donc essayer d'enregistrer une macro, tout simplement en effacent manuellement la partie en trop du chemin d’accès

Il se trouve que quand j'execute la macro :

Sub modifie_lien()
'
' modifie_lien Macro
' changer le chemin d'acces aux photos
'

'
Range("B10").Select
ExecuteExcel4Macro "(4,FALSE,""cciona_pics/423005.JPG"",FALSE,FALSE,FALSE)"
End Sub

Cela me créer un bug, je vois bien que je dois avoir un souci de Range, je l'ai donc changé manuellement de B9 à B10, mais cela vient pas seulement de là.

Autre chose qui m'intrigue, mon dossier ce nome "acciona_pics" mais il prend en compte que ""cciona_pics/

J'ai pas pour habitude de poser des questions, je lis beaucoup, donc passe énormément de temps sur les forums mais la je pars un peu dans tous les sens et j'ai pas beaucoup de temps.


J'aimerais comprendre et que l'on m'aiguille un peu. Le but vous l'aurez comprit, étant de lier des références d'articles à des photos.

Merci
 

Pièces jointes

  • modifie_lien_1.xlsm
    16.1 KB · Affichages: 50
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : Macro pour modifier des liens hypertextes

Bonjour Popcorn

Dans ton cas, le mieux pour éviter tout problème est d'avoir le lien en dur avec le chemin et le nom du fichier. Ainsi, c'est plus facile à gérer par la suite.

Déja dans un premier temps, je pense qu'il y a surement moyen de faire pointer les liens dans le dossier Photo en permanence même si celui ci est déplacé. Je crois que je suis mal partit.bref.

La c'est assez complexe. On peut lié des fichiers mais à terme, si il est déplacé, j'ai un doute sur la méthode.

De plus, il arrive que les liens deviennent inopérant.
 

popcorn

XLDnaute Occasionnel
Re : Macro pour modifier des liens hypertextes

Merci MJ13,

Quand tu dis "lien en dur",concrètement c'est reprendre chaque référence une par une et créer un lien hypertexte pointer sur le fichier voulu.

C'est ce que j'ai fait au départ. En déplacent le dossier sur un autre ordinateur mes liens fonctionnaient toujours.
L’idéal ce serait de stocké les photos en ligne et pointer sur l'url de chacune d'entre elles.

J'ai du reprendre le fichier de départ (problème de mise en page) et comme j'avais déjà fait ce boulot, j'ai collé la colonne avec mes liens. Et la patatrac! J'ai merdé à ce moment là.

J'aimerais justement modifier ces liens hypertextes automatiquement via une macro afin de mettre le chemin exact.

Merci de votre aide
 

popcorn

XLDnaute Occasionnel
Re : Macro pour modifier des liens hypertextes

J'ai trouvé cette macro, merci à l'auteur, ça marche parfaitement.
Changement du chemins d’accès pour vos liens hypertextes.


Sub Modifier_lien()


Dim Doc As Workbook

Dim Cell As Range

Dim OldStr As String

Dim NewStr As String

Dim OldHp As String

Dim NewHp As String


'Chemin à modifier (à adapter à votre fichier, ancien et nouveau chemin d’accès)

OldStr = "../../Desktop/X_pics/"

NewStr = "X_pics/"


Application.Calculation = xlManual


Set Doc = Application.ActiveWorkbook


For Each Cell In Selection


'Verifie si la cellule contient des liens hypertexte

If Cell.Hyperlinks.Count > 0 Then



'Recupère l'adresse du lien sous forme de chaine

OldHp = Cell.Hyperlinks(1).Address



'Remplace l'ancienne chaine par la nouvelle

NewHp = Replace(OldHp, OldStr, NewStr)



'Supprime tous les liens hypertexte de la cellule

Cell.Hyperlinks.Delete



'Affecte le nouveau lien hypertexte

Doc.ActiveSheet.Hyperlinks.Add Anchor:=Cell, Address:=NewHp



End If


Next Cell


Application.Calculation = xlAutomatic


End Sub


Merci
 

Discussions similaires

Réponses
2
Affichages
279
Réponses
4
Affichages
521

Statistiques des forums

Discussions
312 078
Messages
2 085 120
Membres
102 783
dernier inscrit
Basoje