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 Sub

Dans 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 Sub

Question : 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

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...