Copier par programmation des formes avec la mise en forme source (PowerPoint 2007)

Question

Je dois être en mesure de copier des formes (graphique, tableau, etc.) par programmation d'une diapositive à une autre dans PowerPoint 2007 en conservant leurs couleurs d'origine. Les diapositives source et destination sont dans différentes présentations qui ont des thèmes différents. Ces formes peuvent être complexes et inclure beaucoup de couleurs, par exemple des graphiques, des tableaux, etc. La diapositive de destination doit conserver son thème, donc je ne peux pas simplement copier la totalité de la diapositive originale colorScheme.

Lors de la copie manuelle d'une forme dans PowerPoint, j'obtiens une option «Conserver la mise en forme de la source». Cela copie toutes les couleurs d'origine de la forme, convertissant les couleurs de thème en valeurs RVB absolues.

Quelle est la manière la plus simple de le faire par programme?

Answer 1

Vous devez aller à la diapositive et utiliser Application.CommandBars.ExecuteMso

Si vous ne avez pas besoin de revenir à la diapositive précédemment sélectionnée après, vous pouvez sauter DoEvents et le deuxième appel à Application.CommandBars. ExecuteMso

Il m'a semblé que la position de la nouvelle forme était parfois un peu faussée après le collage, donc j'obtiens une référence à la dernière forme dans la collection Shapes de la deuxième diapositive et copiez la position de la forme originale.

Au moins sur ma machine, sans DoEvents, la macro ne ferait rien quand je l'exécuterais (mais cela fonctionnerait si je la parcourais).

Sub CopySelectedShapeToNextSlide() 
    Dim oShape As Shape 
    Dim oSlide As Slide 
    Dim nextSlide As Slide 
    Dim newShape As Shape 

    Set oShape = Application.ActiveWindow.Selection.ShapeRange(1) 
    Set oSlide = Application.ActiveWindow.Selection.SlideRange(1) 
    Set nextSlide = oSlide.Parent.Slides(oSlide.SlideIndex + 1) 

    oShape.Copy 

    Application.ActiveWindow.View.GotoSlide nextSlide.SlideIndex 

    Application.CommandBars.ExecuteMso "PasteSourceFormatting" 
    Set newShape = nextSlide.Shapes(nextSlide.Shapes.Count) 
    newShape.Left = oShape.Left 
    newShape.Top = oShape.Top 

    DoEvents 

    Application.ActiveWindow.View.GotoSlide oSlide.SlideIndex 

    Debug.Print newShape.Name 

End Sub