Programmatically copy shapes with source formatting (PowerPoint 2007)

Question

I need to be able to copy shapes (chart, table, etc.) programmatically from one slide to another in PowerPoint 2007 keeping their original colors. The source and destination slides are in different presentations which have different themes.

These shapes might be complex and include a lot of colors, e.g., charts, tables, etc. The destination slide must maintain its theme, so I cannot simply copy the entire original slide colorScheme.

When copying a shape manually in PowerPoint, I get an option to "Keep Source Formatting". This copies all the original colors of the shape, converting theme colors into absolute RGB values.

What is the simplest way to do this programmatically?

You probably have to get the absolute RGB values, via a pipeline like this for each Object: Theme->getColorForIndex(Object->getThemeColorIndex) — pintxo

Jbjstam Jbjstam · Accepted Answer · 2016-09-30T11:16:56

You need to go to the slide and use Application.CommandBars.ExecuteMso

If you don't need to return to the previously selected slide afterwards, you can skip DoEvents and the second call to Application.CommandBars.ExecuteMso

It seemed like the position of the new shape was sometimes a little bit skewed after pasting, so I obtain a reference to the last shape in the Shapes collection of the second slide and copy the position of the original shape.

At least on my machine, without DoEvents, the macro would do nothing when I executed it (but it would work if I stepped through it).

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

Programmatically copy shapes with source formatting (PowerPoint 2007)

1 Answers