VBA changement de source automatique ppt/excel

  • Initiateur de la discussion Initiateur de la discussion lukill
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

lukill

XLDnaute Nouveau
Bonjour !

je viens vous demander de l'aide sur un problème que j'ai du mal à résoudre du fait de mon niveau débutant en VBA.

J'ai un fichier ppt dans lequel j'ai copié plusieurs graphiques et cellules en fichier lié à partir d'un seul et même fichier excel.

Si je déplace mes fichiers vers un autre ordianteur, je dois modifier toutes les sources des graphiques et cellules. J'ai trouvé ce code sur le forum et il fonctionne parfaitement pour les graphiques :

PHP:
Sub ChangerLiaisonsOLElinked()
 
'### Constante à adapter (nouveau chemin et/ou nouveau nom du classeur source) ###
 Const NEW_PATH As String = "c:\1111base PPT.xls"
 '#################################################################################
 
Dim SL As Slide
 Dim SH As Shape
 Dim LF As LinkFormat
 Dim A$
 Dim PathLink$
 Dim ClasseurSource$
 Dim OleObjectRefer$
 Dim NewClasseur$
 '---
 For Each SL In ActivePresentation.Slides
   For Each SH In SL.Shapes
     If SH.Type = msoLinkedOLEObject Then
       Set LF = SH.LinkFormat
       '--- Source actuelle ---
       A$ = LF.SourceFullName
         '°°° Le chemin du classeur source °°°
       PathLink$ = Mid(A$, 1, InStr(1, A$, "!") - 1)
         '°°° Le classeur source °°°
       If InStr(1, A$, "[") > 0 Then
         ClasseurSource$ = Mid(A$, InStr(1, A$, "[") + 1)
         ClasseurSource$ = Mid(ClasseurSource$, 1, InStr(1, ClasseurSource$, "]") - 1)
       End If
         '°°° L'objet source (graphique, tableau, ...) °°°
       OleObjectRefer$ = Mid(A$, Len(PathLink$) + 1)
       '--- Nouvelle source (classeur source et objet source) ---
       If InStr(1, A$, "[") > 0 Then
         NewClasseur$ = Mid(NEW_PATH, InStrRev(NEW_PATH, "\") + 1)
         OleObjectRefer$ = Replace(OleObjectRefer$, ClasseurSource$, NewClasseur$)
       End If
       LF.SourceFullName = NEW_PATH & OleObjectRefer$
       LF.Update
     End If
   Next SH
 Next SL
 End Sub

Par contre il ne prend pas en compte les sources qui font référence à des cellules,

Sauriez-vous m'indiquer quelle ligne ajouter à ce code ?

Merci beaucoup pour vos réponses !!
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour