Mise à jour des liaisons sur Excel

Symptômes


Comment mettre à jour les liaisons sous Excel ?


Résolution


Le seul moyen de mettre à jour les liaisons sur des documents existants
est d'écrire une macro qui va ouvrir toutes les liaisons et modifier la
source.


EXEMPLE :

Voici une macro, uniquement à titre d'exemple, qui permettra de mettre à
jour les liaisons.

Mode d'emploi de la macro
=========================
- Copiez le code dans un nouveau document
- Lancez cette macro
- Cette macro vous demandera d'ouvrir un fichier excel
- Choisissez un fichier pour lequel vous voulez mettre à jour les
liaisons
- Rentrez le nom du serveur que vous voulez supprimer
- La macro va uniquement rechercher les liaisons avec ce serveur, les
autres liaisons ne seront pas modifiées
- Ensuite, rentrez le nom du nouveau serveur
- Le fichier va se fermer
- Lors de sa réouverture il vous sera demandé de mettre à jour à jour les
liaisons: répondez oui et toutes les liaisons se mettront à jour.

Remarque:

Pour que cette macro fonctionne il vous faut garder les mêmes noms de
répertoires et de fichiers lors de la migration: c'est uniquement le nom
du serveur qui va changer.


Sub changementliaison()

Dim FName As String, aLinks As Variant, wb As Workbook
Dim nomserveur, OldServer, Newlinks, OldDrive As String
Dim tempPath As String
Dim longueur As Integer, a As Integer, b As Integer

FName = Application.GetOpenFilename("Microsoft Excel Files (*.xls),
*.xls", _
, "Browse...", , False)
If FName = "False" Then Exit Sub

Set wb = Workbooks.Open(FName, UpdateLinks:=0)
Application.AskToUpdateLinks = False aLinks = wb.LinkSources(xlOLELinks)
' recherche du document à modifier

If Not IsEmpty(aLinks) Then
MsgBox wb.FullName & " Contient " & UBound(aLinks) & " Liaisons"
'affichage du nombre de liaisons dans le document
OldServer = InputBox("Entrez le nom du serveur que vous voulez
supprimer")
longueur = Len(OldServer)
For i = 1 To UBound(aLinks)

a = InStr(aLinks(i), "\\")
b = a + 2
nomserveur = Mid(aLinks(i), b, longueur)

If nomserveur = OldServer Then

If InStr(aLinks(i), "\\") > 0 Then

MsgBox "Ancien chemin unc de la liaison " & aLinks(i)

Newlinks = InputBox("Entrez le nom du nouveau serveur")

wb.ChangeLink aLinks(i), _
Application.Substitute(aLinks(i), _
OldServer, Newlinks, 1), xlOLELinks
Else

End If
Else
End If
Next i
wb.Save
End If

Application.AskToUpdateLinks = True

wb.Close False

End Sub


MOTS-CLES :
La liste de(s) mot(s) suivant(s) permet une recherche plus efficace de
cette fiche technique :
Macro, excel, liaisons, mise à jour



kbusage
Propriétés

ID d'article : 19907 - Dernière mise à jour : 15 janv. 2004 - Révision : 1

Commentaires