我需要编写一个可以遍历演示文稿并将文本字符串的所有实例更改为其他实例的程序。因此,例如,只要出现文本字符串“Old Company Name”,就会将其替换为“New Company Name”。
我对如何自动化Powerpoint有了一般的想法,挑战在于难以走动形状对象,而且我没有看到存储这些数据的明显属性(例如,“文本”)属性。)
有人能指出我正确的方向吗?
此外,是否有一个工具可以更容易地挖掘Office产品的对象模型,也就是说走一个特定文档的实例对象树?通常我会使用Visual Studio调试器执行此操作,但由于它是COM顶部的薄层,因此您无法像在其他情况下那样轻松地在监视窗口中遍历对象实例树。有没有一个很好的工具来帮助解决这个问题?
PPT 2010如果重要。
答案 0 :(得分:3)
Powerpoint是自动化(使用VBA)的一个比较棘手的Office应用程序,因为您无法像使用Word和Excel那样记录宏。我发现学习对象模型的最佳方法是将Web搜索和对象浏览器与VBIDE结合使用(只需按F2)。
至于文本替换,一旦你知道,这是一个简单的案例。您可以遍历特定幻灯片中的所有形状,然后检查该形状的文本。 (请注意,此代码实际上来自Excel工作簿,因此它具有Powerpoint
引用,这些引用在Powerpoint中是不必要的:
编辑:Steve对原始的仅编辑搜索文本框提出了一个非常好的观点,根据您的演示文稿设置,您必须单独对每种类型的对象进行排序并实现自定义替换每种类型。只是背部疼痛并不是特别困难。
另请注意,根据演示文稿的大小,可能需要一段时间才能循环显示所有形状。我还使用了.HasTextFrame
/ .HasTable
与.Type
的组合,因此您可以看到这两种类型。
Sub ReplaceTextShape(sFindText As String, sNewText As String, ppOnSlide As PowerPoint.Slide)
Dim ppCurShape As PowerPoint.Shape
For Each ppCurShape In ppOnSlide.Shapes
If ppCurShape.HasTextFrame Then
ppCurShape.TextFrame.TextRange.Text = VBA.Replace(ppCurShape.TextFrame.TextRange.Text, sFindText, sNewText)
ElseIf ppCurShape.HasTable Then
Call FindTextinPPTables(ppCurShape.Table, sFindText, sNewText)
ElseIf ppCurShape.Type = msoGroup Then
Call FindTextinPPShapeGroup(ppCurShape, sFindText, sNewText)
''Note you'll have to implement this function, it is an example only
ElseIf ppCurShape.Type = msoSmartArt Then
Call FindTextinPPSmartArt(ppCurShape, sFindText, sNewText)
''Note you'll have to implement this function, it is an example only
ElseIf ppCurShape.Type = msoCallout Then
'etc
ElseIf ppCurShape.Type = msoComment Then
'etc etc
End If
Next ppCurShape
Set ppCurShape = Nothing
End Sub
然后替换整个演示文稿中的所有文本:
Sub ReplaceAllText(ppPres As PowerPoint.Presentation)
Dim ppSlide As PowerPoint.Slide
For Each ppSlide In ppPres.Slides
Call ReplaceTextShape("Hello", "Goodbye", ppSlide)
Next ppSlide
Set ppSlide = Nothing
End Sub
用于替换表中文本的示例代码:
Sub FindTextinPPTables(ppTable As PowerPoint.Table, sFindText As String, sReplaceText As String)
Dim iRows As Integer, iCols As Integer
With ppTable
iRows = .Rows.Count
iCols = .Columns.Count
For ii = 1 To iRows
For jj = 1 To iCols
.Cell(ii, jj).Shape.TextFrame.TextRange.Text = VBA.Replace(.Cell(ii, jj).Shape.TextFrame.TextRange.Text, sFindText, sReplaceText)
Next jj
Next ii
End With
End Sub