选择并复制形状独特的Powerpoint VBA内容

Question

我想在每张幻灯片中选择"矩形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

Answer 1

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

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

Answer 2

当您更改问题时，请考虑启动一个新线程，而不是将其固定到上一个线程。试试这个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