Erreur dans mon code VBA?
Bonjour le forum,
j'ai un fichier pro qui me pose pb...
C'est un gros fichier d'une 20aine de Mo...
Sur ce fichier, j'ai plusieurs liens hypertextes (plusieurs 100aines...) qui pointent vers un serveur réseau.
Quand j'ai des plantages, tous ces liens pètent...
J'ai passé en début de semaine derniere 1 journée pour tous les remettre d'équerre 1 par 1...
Plantage à nouveau ce matin... :'(
En cherchant sur Google, j'ai trouvé ce code
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
OldStr = "\\Ogidoc1\Doc OGI\"
NewStr = "\\ogi.local\racineogi\data\OGIDOC\Doc ogi\"
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 SubDans mon cas, les chemins à modifier sont :
OldStr = "c:\Users\ng2a240\AppData"
NewStr = "\\sfs.corp\Projects\FINANCE\Costing_Geco\Altran\525167-nacelle A350\525167-Issue 1"
soit ce code :
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
OldStr = "c:\Users\ng2a240\AppData"
NewStr = "\\sfs.corp\Projects\FINANCE\Costing_Geco\Altran\525167-nacelle A350\525167-Issue 1"
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 SubQuestion : pourquoi ca marche pas? Je ne connais rien en VBA, et ne peux malheureusement pas joindre de fichier : réduit à son plus simple appareil, je descend pas en dessous de 8Mo
- Messages
- 1'794
- Excel
- 2010
- Inscrit
- 25/08/2014
- Emploi
- Consultant VB6 / SQL / VBA / Excel / Access
Bonsoir,
Fonctionne sur mon poste.
Avant de lancer le traitement, il faut sélectionner la plage de cellules contenant les liens à modifier
A re-tester
Bonne soirée
Bouben
Bonsoir,
merci pour la réponse.
Effectivement, j'ai compris en regardant le code qu'il fallait sélectionner les cellules avant... mais rien à faire...
idem sur le fichier joint (un test que j'ai fait chez moi)
Est ce parce que je sélectionne toute une colonne (donc des cellules vides? visiblement non car même en ne sélectionnant qu'une celle cellule à modifier ca marche pas...