Power Point Intégrer diapositive via collage spécial avec liaison

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 !

pierre1777

XLDnaute Nouveau
Bonjour à tous,
je vais essayer d'être clair, j'aimerai importer une diapositive et faire un "coller avec liaison" pour que cette derniere se mette à jour quand je modifie le ppt "source".

Le problème c'est que le collage se fait mais pas de liaison.
Le résultat est comme le "CTRL+ALT+V coller" mais pas copier avec liaison. donc au final j'ai une slide ou je peux double cliquer dessus pour modifier mais pas de MAJ en cas de modification du ppt source.
J'ai déjà essayé ces deux lignes de commandes :

Presentation.Slides(Presentation.Slides.Count).Shapes.PasteSpecial ppPasteOLEObject, , , , msoFalse
Presentation.Slides(Presentation.Slides.Count).Shapes.PasteSpecial ppPasteOLEObject, , , , msoTrue (en principe c'est celle-ci qui devrait fonctionner je pense)

je teste cela sur un ppt2019 mais la finalité serait qu'il fonctionne sur un 2016.

voici la partie du code avec le collage spécial que j'utilise.

merci à tous pour votre aide
 

Pièces jointes

Solution
Bonjour Pierre, le forum,

Tu trouveras un code ci-dessous qui fonctionne, du moins chez moi :
VB:
Sub test()
Dim extPresentation As PowerPoint.Presentation
Dim thisPresentation As PowerPoint.Presentation
Dim emptyCustomLayout As PowerPoint.CustomLayout
Dim nouvelleDiapo As PowerPoint.Slide
Dim nouvelleShape As Shape
    
    'définir la présentation où créer la nouvelle slide
    Set thisPresentation = ActivePresentation
    
    'ouvrir la présentation dont on doit copier la slide
    Set extPresentation = Application.Presentations.Open("C:\...\extPresentation.pptx", True)
    'copier la slide 1
    extPresentation.Slides(1).Copy
    
    'ajouter une nouvelle diapositive vide en dernière position
    With thisPresentation
        Set...
Bonjour Pierre, le forum,

Tu trouveras un code ci-dessous qui fonctionne, du moins chez moi :
VB:
Sub test()
Dim extPresentation As PowerPoint.Presentation
Dim thisPresentation As PowerPoint.Presentation
Dim emptyCustomLayout As PowerPoint.CustomLayout
Dim nouvelleDiapo As PowerPoint.Slide
Dim nouvelleShape As Shape
    
    'définir la présentation où créer la nouvelle slide
    Set thisPresentation = ActivePresentation
    
    'ouvrir la présentation dont on doit copier la slide
    Set extPresentation = Application.Presentations.Open("C:\...\extPresentation.pptx", True)
    'copier la slide 1
    extPresentation.Slides(1).Copy
    
    'ajouter une nouvelle diapositive vide en dernière position
    With thisPresentation
        Set emptyCustomLayout = .SlideMaster.CustomLayouts(7)   '7 = vide, dans mon modèle de présentation
        Set nouvelleDiapo = .Slides.AddSlide(.Slides.Count + 1, emptyCustomLayout)
    End With
    
    'copier la diapositive et récupérer la Shape
    Set nouvelleShape = nouvelleDiapo.Shapes.PasteSpecial(ppPasteOLEObject, , , , , True).Item(1)
    
    'positionner et dimentionner la shape
    nouvelleShape.Top = 0
    nouvelleShape.Left = 0
    nouvelleShape.LockAspectRatio = True
    nouvelleShape.Width = nouvelleDiapo.Master.Width
    
    'fermer la présentation externe
    extPresentation.Close
End Sub

Après avoir exécuté ce code, une diapositive a bien été ajoutée contenant une image de la première slide de la présentation extPresentation.pptx.
Si cette dernière est modifiée, cela est bien impacté dans la présentation.

A+
 
Merci Romain pour ton aide effectivement cela fonctionne sur ppt 2016 au bureau plus qu'a tester sur le 2019 mais le principal est le résultat au bureau.
Merci beaucoup

@bientot pour une autre aide, car la finalité sera de récupérer des liens de fichiers ppt dans des cellules Excel et d'en faire un ppt, il faudra rester à l'affût du forum 🤣🤣🤣🤣🤣
 
- 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

Réponses
10
Affichages
1 K
Retour