Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2572 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro rechercher remplacer liens hypertexte EXCEL 2010

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Macro rechercher remplacer liens hypertexte EXCEL 2010

n°2267898
corias
Posté le 16-10-2015 à 17:45:37  profilanswer
 

Bonjour,
 
Je souhaite modifier des liens hypertextes de classeurs excel (sous excel 2010) en masse(à cause d'un changement de serveur).  
En fait ce serait du coup seulement le début du lien à modifier
 
exemple :
remplacer \\serveur1\dossier 2\
 
par \\serveur4\partage\dossier 2\
 
Je ne sais pas si le file:/// avant l'adresse doit être pris en compte.
J'ai trouvé au moins 3 macros différentes sur le net mais aucune ne fonctionne. :heink:  :heink:  
Pas de message d'erreur
 
Voici les macros en question:
 
MACRO1:

Code :
  1. Sub Modifier_lien()
  2. Dim Doc As Workbook
  3. Dim Cell As Range
  4. Dim OldStr As String
  5. Dim NewStr As String
  6. Dim OldHp As String
  7. Dim NewHp As String
  8. 'Chemin à modifier
  9. OldStr = "\\serveur1\dossier 2\"
  10. NewStr = "\\serveur4\partage\dossier 2\"
  11. Application.Calculation = xlManual
  12. Set Doc = Application.ActiveWorkbook
  13. For Each Cell In Selection
  14. 'Verifie si la cellule contient des liens hypertexte
  15. If Cell.Hyperlinks.Count > 0 Then
  16. 'Recupère l'adresse du lien sous forme de chaine
  17. OldHp = Cell.Hyperlinks(1).Address
  18. 'Remplace l'ancienne chaine par la nouvelle
  19. NewHp = Replace(OldHp, OldStr, NewStr)
  20. 'Supprime tous les liens hypertexte de la cellule
  21. Cell.Hyperlinks.Delete
  22. 'Affecte le nouveau lien hypertexte
  23. Doc.ActiveSheet.Hyperlinks.Add Anchor:=Cell, Address:=NewHp
  24. End If
  25. Next Cell
  26. Application.Calculation = xlAutomatic
  27. End Sub


 
MACRO2
 

Code :
  1. Sub FixHyperlinks()
  2.     Dim hl As Hyperlink
  3.     For Each hl In ActiveSheet.Hyperlinks
  4.         hl.Address = Replace(hl.Address, "\\serveur1\dossier 2\", "\\serveur4\partage\dossier 2\" )
  5.     Next hl
  6. End Sub


 
MACRO3
 

Code :
  1. Sub FindReplaceHLinks(sFind As String, sReplace As String, _
  2.     Optional lStart As Long = 1, Optional lCount As Long = -1)
  3.     Dim rCell As Range
  4.     Dim hl As Hyperlink
  5.     For Each rCell In ActiveSheet.UsedRange.Cells
  6.         If rCell.Hyperlinks.Count > 0 Then
  7.             For Each hl In rCell.Hyperlinks
  8.                 hl.Address = Replace(hl.Address, sFind, sReplace, lStart, lCount, vbTextCompare)
  9.             Next hl
  10.         End If
  11.     Next rCell
  12. End Sub
  13. Sub Doit()
  14.     FindReplaceHLinks "\\serveur1\dossier 2\", "\\serveur4\partage\dossier 2\"
  15. End Sub


 
Merci aux éventuelles personnes susceptibles de m'aider  :jap:  :jap:

mood
Publicité
Posté le 16-10-2015 à 17:45:37  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro rechercher remplacer liens hypertexte EXCEL 2010

 

Sujets relatifs
[EXCEL/VBA] Automatiser remplissage de fichierInsérer des images avec légende dans word 2010
Excel formule avec si(et(ou[EXCEL ou VBA] Chercher une valeur parmi un ensemble de valeur
[EXCEL] passer d'un tableau croisé à des lignes à platcopier des cellules excel et les ajouter au corps de mail en image
Passage d'excel à une page webremplacer une ligne dans un fichier
Excel (liste avec des valeurs identiques/graph)Transfert de données d'un fichier excel à un autre
Plus de sujets relatifs à : Macro rechercher remplacer liens hypertexte EXCEL 2010


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR