Discussion :

[Aby55]

Bonjour,

Ma présentation PowerPoint est liée à un fichier excel. Le nom de ce dernier change tous les mois. Du coup, j'utilise une macro pour modifier les liaisons automatiquement. Cependant, depuis que j'ai changé d'office pour 2013, ma macro ne fonctionne plus et je n'ai aucun message d'erreur. Pouvez vous m'aider, svp?
Voici la macro :

Sub Test()

Dim pwrPoint As PowerPoint.Application
Dim Prez As PowerPoint.Presentation
Dim targetMaj As String
Dim Presentation As String
Dim Forme As PowerPoint.Shape
Dim Diapo As PowerPoint.Slide
Dim PathPPT As String
Dim PathXLS As String
Dim oldSrc As String

'Chemin des fichiers (PowerPoint / Nouveau fichier Excel)
PathPPT = ActivePresentation.Path & "\"
PathXLS = ActivePresentation.Path & "\"
'Fichier PowerPoint
Presentation = "Présentation_03-2015.pptm"
'Le nouveau classeur lié
targetMaj = "Tableau_de_bord_2015-03.xlsx"

Set pwrPoint = CreateObject("PowerPoint.Application")
pwrPoint.Visible = msoTrue
Set Prez = pwrPoint.Presentations.Open(PathPPT & Presentation)

Dim ind As Integer
Dim Tmp As String
Dim Suffixe As String

'Boucle sur les Slide de la présentation
For Each Diapo In Prez.Slides
'Boucle sur les formes
For Each Forme In Diapo.Shapes
'Vérifie s'il s'agit d'un objet lié
If Forme.Type = msoLinkedOLEObject Then
'Vérifie si l'objet lié est un objet Excel
If Forme.OLEFormat.ProgID = "Excel.Sheet.8" Then
'Initialise les variables
Tmp = Forme.LinkFormat.SourceFullName
Suffixe = ""
oldSrc = Forme.LinkFormat.SourceFullName

'Recherche du suffixe (premier ! dans l)
ind = InStr(Tmp, "!")
If (ind > 0) Then
Suffixe = Right(Tmp, Len(Tmp) - ind + 1)
End If

'Recherche de l'ancien nom de fichier
ind = InStrRev(Forme.LinkFormat.SourceFullName, "\")
If (ind > 0) Then
oldSrc = Right(Forme.LinkFormat.SourceFullName, Len(Tmp) - ind)
End If
oldSrc = Replace(oldSrc, Suffixe, "")

'Corrige une erreur sur le nom de l'ancien fichier en cas de mauvais mappage
ind = InStr(Suffixe, "[")
If (ind > 0) Then
oldSrc = Right(Suffixe, Len(Suffixe) - ind)
ind = InStr(oldSrc, "]")
If (ind > 0) Then
oldSrc = Left(oldSrc, ind - 1)
End If
End If

'Remplace le nom de l'ancien fichier dans le suffixe
Suffixe = Replace(Suffixe, oldSrc, targetMaj)

'Modifie la source
Forme.LinkFormat.SourceFullName = PathXLS & targetMaj & Suffixe
'Mise à jour
Forme.LinkFormat.Update
End If
End If

Next
Next

'Prez.Save
'ferme la présentation
'Prez.Close
'ferme powerpoint
'pwrPoint.Quit

End Sub

Merci d'avance

[m@rina]

Bonjour,

Je n'ai pas regardé ta macro de près et j'ignore pourquoi elle ne fonctionne plus avec la version 2013.

Cela étant, je ne pense pas que ce soit la meilleure solution de changer à chaque fois le nom du fichier.
Voilà comment j'ai opéré maintes fois supposant que ton classeur Excel est toujours le même et que ce sont uniquement les données qui changent.
- J'ai mes classeurs Excel mensuels comme toi.
- Mais chaque mois, une fois le classeur fait, je réenregistre ce dernier classeur sous un deuxième nom, unique celui-là.
- La liaison dans PowerPoint se fait une fois pour toutes avec ce classeur mis à jour chaque mois.

ça me paraît beaucoup plus simple.
m@rina