选择并复制Powerpoint VBA中唯一形状的内容

我想在每张幻灯片中选择“矩形132”，使用VBA将内容复制到“大纲菜单”中作为幻灯片的标题

最终，最好将“标题”标题放在实际幻灯片上方，这样它就不会显示在幻灯片上

Sub LoopThroughSlides()

'PURPOSE: Show how to loop through all slides in the active presentation

Dim sld As Slide
'Loop Through Each Slide in ActivePresentation
  For Each sld In ActivePresentation.Slides
    'Do something...(ie add a transition to slides)

      Function getShapeByName(shapeName As String, Slide As Integer)
    Set getShapeByName = ActivePresentation.Slides(Slide).Shapes(shapeName)
End Function

Dim myshape As Shape
myshape = getShapeByName("Rectangle 132", 1)

  Next sld

End Function

End Sub

•••ˇ

我发现了这一点，但不确定如何应用：

With ActivePresentation.Slides(1)

    If .Layout <> ppLayoutBlank Then

        With .Shapes

            If Not .HasTitle Then

                .AddTitle.TextFrame.TextRange.Text = "Restored title"

            End If

        End With

    End If

End With

带ActivePresentation.Slides的

（1）
如果.Layout pplayout为空，则
形状
如果不是的话，那么是哈斯蒂尔
.AddTitle.TextFrame.TextRange.Text=“还原的标题”
如果结束
以
如果结束
以

很抱歉，标题不是这样的。标题占位符在程序中具有特殊状态，无法转移到其他形状。如果您从矩形132复制文本并将其粘贴到标题占位符，它将按预期工作

---

为了说明占位符的特殊性质，我使用空白布局创建了一张幻灯片，该布局没有标题。我打开大纲视图，然后在幻灯片缩略图旁边键入文本。本文自动考虑幻灯片标题和PowerPoint在空白幻灯片上创建标题占位符，即使它以前没有一个。

< P>当您更改问题时，请考虑启动一个新线程，而不是将其挂在前一个线程上。请尝试使用此VBA：

Sub SetTitle()
    Dim sld As Slide, oShape As Shape, TitleText As String, TitlePHName As String

    For Each sld In ActivePresentation.Slides
        For Each oShape In sld.Shapes
            If oShape.Name = "Rectangle 132" Then
                If oShape.HasTextFrame Then
                    If oShape.TextFrame2.HasText Then
                        TitleText = oShape.TextFrame2.TextRange.Text
                    End If
                End If
            End If
            If Left(oShape.Name, 5) = "Title" Then
                TitlePHName = oShape.Name
            End If
        Next oShape
        If sld.Layout <> ppLayoutBlank Then
            If sld.Shapes.HasTitle Then
                sld.Shapes(TitlePHName).TextFrame2.TextRange.Text = TitleText
            Else
                sld.Shapes.AddTitle.TextFrame2.TextRange.Text = TitleText
            End If
        End If
        TitlePHName = ""
        TitleText = ""
    Next sld
End Sub

Sub-SetTitle（）
Dim sld作为幻灯片，oShape作为形状，TitleText作为字符串，TitlePHName作为字符串
对于ActivePresentation.Slides中的每个sld
对于sld.形状中的每个oShape
如果oShape.Name=“矩形132”，则
如果是oShape.HasTextFrame，那么
如果是oShape.TextFrame2.HasText，则
TitleText=oShape.TextFrame2.TextRange.Text
如果结束
如果结束
如果结束
如果左（oShape.Name，5）=“标题”，则
TitlePHName=oShape.Name
如果结束
下一个奥沙佩
如果sld.Layout pplayout为空，则
如果sld.Shapes.hastintle那么
sld.Shapes（TitlePHName）.TextFrame2.TextRange.Text=TitleText
其他的
sld.Shapes.AddTitle.TextFrame2.TextRange.Text=TitleText
如果结束
如果结束
TitlePHName=“”
TitleText=“”
下一个sld
端接头

您已将一个函数放置在Sub内。它应该在Sub外。请告诉我们你想完成什么，因为可能有更好的方法。您的第二个子项添加了一个标题，但您似乎希望避免将标题用作大纲中幻灯片的常规引用。@JohnKorchok我希望形状（矩形132）中的文本作为每张幻灯片的标题。因此，矩形132是每张幻灯片上的“真实”标题-但在大纲中没有标题；我希望大纲中的标题为=矩形132。我希望从矩形132复制文本并将其粘贴到标题占位符中。这正是你在第二段中提到的功能，我想利用它。我已经在每张幻灯片中都有了文本，用矩形132表示。谢谢。很抱歉，我们不熟悉此站点的最佳实践。脚本返回错误：形状（未知成员）：请求无效。本幻灯片不允许标题。这一行有漏洞：sld.Shapes.AddTitle.TextFrame2.TextRange.Text=titletext我发布的VBA在标准Microsoft模板上工作。听起来你不仅仅是一个没有标题占位符的空白布局。您必须通过修改布局或添加另一条If-Then语句来检查自定义布局名称来处理此问题。