Bonjour à tous,
Le titre pose les bases de mon problème.
J'ai créé un PowerPoint avec des graphiques et des tableaux liés à un seul et même fichier Excel qui sert de modèle de présentation.
De ce fait, je suis amené à dupliquer ces deux documents (pptm et xlsx) en fonction des données que je souhaite rentrer. Mon problème est que le fichier PowerPoint reste lié au fichier Excel original or je souhaite qu'il soit lié au nouveau fichier excel.
Ex : Dossier Modèle Contenant Présentation.pptm et Analyse.xlsx
Copier/Coller et renommer =>
Dossier1 Contenant Présentation1.pptm et Analyse1.xlsx (problème, présentation1.pptm est toujours lié à Analyse.xlsx.... )
J'ai une centaine de lien à modifier et c'est donc très long de le faire à ma main. Je me suis donc tourner vers les macros et après des recherches et des essais infructueux, je me tourne vers vous pour savoir si vous avez déjà rencontrer ce problème et si vous pouvez m'aider à ce sujet.
Macro Testée :
Macro testée :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51 Sub lien() Dim pwrPoint As PowerPoint.Application Dim Prez As PowerPoint.Presentation Dim targetMaj As String Dim Ancienlien As String Dim Newlien As String Dim Nouveaulien As String Dim Forme As PowerPoint.Shape Dim Diapo As PowerPoint.Slide Presentation = "C:\Dropbox\Testmacro.pptm" 'Le nouveau classeur lié targetMaj = "C:\Dropbox\Testmacro1.xls" 'Set pwrPoint = CreateObject("PowerPoint.Application") 'pwrPoint.Visible = msoTrue 'Set Prez = pwrPoint.Presentations.Open(Presentation) 'Boucle sur les Slide de la présentation For Each Diapo In ActivePresentation.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.12" Or Forme.OLEFormat.ProgID = "Excel.chart.12" Then 'Modifie la source 'Ancienlien = Forme.LinkFormat.SourceFullName Newlien = Mid(Ancienlien, InStrRev("Test")) Nouveaulien = Replace(Ancienlien, macro1, marco) If Ancienlien <> Nouveaulien Then Forme.LinkFormat.SourceFullName = Nouveaulien 'Forme.LinkFormat.SourceFullName = targetMaj 'Mise à jour Forme.LinkFormat.Update End If End If Next Next 'Prez.Save 'sauvearde la présentation 'Prez.Close 'ferme powerpoint 'pwrPoint.Quit End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub MAJLIEN() Dim oldPath As String, newPath As String Dim pptPres As Presentation, pptSlide As Slide, pptShape As Shape newPath = "C:\Dropbox\TestMacro1.xlsx" oldPath = "C:\Dropbox\TestMacro.xlsx" 'loop on each slides, and on each shapes Set pptPres = ActivePresentation For Each pptSlide In pptPres.Slides For Each pptShape In pptSlide.Shapes If pptShape.Type = msoLinkedOLEObject Then 'if it is a "linked object" then If pptShape.LinkFormat.SourceFullName = oldPath Then pptShape.LinkFormat.SourceFullName = newPath 'modify the link pptShape.LinkFormat.Update 'update the link End If End If Next pptShape Next pptSlide End Sub
Partager