Remplacement de liens hypetextes - fichiers différents
Bonjour à tous,
Je suis novice dans tout ce qui est codage de macro sous VBA et je rencontre actuellement quelques soucis d'exécution ...
J'ai créé une macro qui permet de remplacer des liens hypertextes en quantité et en sélection manuelle. Pour cela, j'ai créé un fichier test qui est parfaitement fonctionnel. Cependant, lorsque je transpose mon code sur mon fichier final, avec les vrais liens à modifier, la macro s'exécute sans bug (a priori) mais aucun n'effet ne se produit (voici le bug!), c'est à dire que les liens ne sont pas modifiés.
Le plus étrange: lorsque j'active la macro avec le code fraichement rentré, il fonctionne de manière aléatoire (c'est à dire qu'à la première execution tout se passe bien) mais lorsque je le ferme (après avoir enregistré bien sûr) et que je le ré-ouvre, aucun moyen de lancer la macro pour avoir un résultat. Les fichiers sont enregistrés en .xlsxm pour Excel 2010.
Je vous poste le code que j'utilise:
Sub Modifier_hyperlien_test()
'Application.Calculation = xlManual
ancienne_chaine = "D:\h571597\Documents\My Pictures"
nouvelle_chaine = "D:\h571597\Documents\My Music"
For Each cellule In Selection
'on boucle sur les hyperliens de la cellule
If cellule.Hyperlinks.Count > 0 Then
'ancien hyperlien récupéré dans ancien hyperlien
ancien_hyperlien = cellule.Hyperlinks(1).Address
'Remplace l'ancienne chaine par la nouvelle et le place dans nouvel_hyperlien
nouvel_hyperlien = Replace(ancien_hyperlien, ancienne_chaine, nouvelle_chaine)
'Supprime le lien hypertexte de la cellule
cellule.Hyperlinks.Delete
'Affecte le nouveau lien hypertexte
Application.ActiveWorkbook.ActiveSheet.Hyperlinks.Add Anchor:=cellule, Address:=nouvel_hyperlien
End If
Next cellule
'Application.Calculation = xlAutomatic
End Sub
un code altérnatif:
Sub Modifier_hyperlien_test2()
'Application.Calculation = xlManual
ancienne_chaine = "D:\h571597\Documents\My Pictures"
nouvelle_chaine = "D:\h571597\Documents\My Music"
For Each cellule In Selection
'on boucle sur les hyperliens de la cellule
For Each hyperlien In cellule.Hyperlinks
'ancien hyperlien récupéré dans ancien hyperlien
ancien_hyperlien = hyperlien.Address
'Remplace l'ancienne chaine par la nouvelle et le place dans nouvel_hyperlien
nouvel_hyperlien = Replace(ancien_hyperlien, ancienne_chaine, nouvelle_chaine)
'Supprime le lien hypertexte de la cellule
hyperlien.Delete
'Affecte le nouveau lien hypertexte
Application.ActiveWorkbook.ActiveSheet.Hyperlinks.Add Anchor:=cellule, Address:=nouvel_hyperlien
Next hyperlien
Next cellule
'Application.Calculation = xlAutomatic
End Sub
Auriez-vous une piste que je pourrais explorer?
Merci d'avance (désolé si le sujet à déjà été traité, j'ai fouillé un peu sans succès, problème de mots clés surement ^^)
Erratum:
Les liens hypetextes en question pointent vers des fichiers directement, par exemple:
D:\h571597\Documents\My Pictures\1.bmp
qui devient, après déplacement du fichier cible:
D:\h571597\Documents\My Music\1.bmp
Les liens pointent vers un réseau d'entreprise, que je ne suis pas autorisé à déposer sur ce site bien entendu. Le fait qu'il ne s'agisse pas d'un lien en local peut-il poser problème?