当前位置：文江博客话题详情

以编程方式复制具有源格式的形状 (PowerPoint 2007)

发布于 2024-10-01 16:35:45 字数 282 浏览 0 评论 0原文

我需要能够在 PowerPoint 2007 中以编程方式将形状（图表、表格等）从一张幻灯片复制到另一张幻灯片，并保持其原始颜色。源幻灯片和目标幻灯片位于具有不同主题的不同演示文稿中。

这些形状可能很复杂并且包含很多颜色，例如图表、表格等。目标幻灯片必须保持其主题，因此我不能简单地复制整个原始幻灯片 colorScheme。

在 PowerPoint 中手动复制形状时，我可以选择“保留源格式”。这将复制形状的所有原始颜色，将主题颜色转换为绝对 RGB 值。

以编程方式执行此操作的最简单方法是什么？

原文

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

南七夏 2024-10-08 16:35:45

您需要转到幻灯片并使用 Application.CommandBars.ExecuteMso

如果之后不需要返回到之前选择的幻灯片，则可以跳过 DoEvents 和对 Application.CommandBars.ExecuteMso

的第二次调用看起来像新形状在粘贴后有时会有点倾斜，因此我获取了对第二张幻灯片的 Shapes 集合中最后一个形状的引用，并复制原始形状的位置。

至少在我的机器上，如果没有 DoEvents，宏在执行时不会执行任何操作（但如果我单步执行它，它就会起作用）。

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

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

回复收藏 0 原文

~没有更多了~