powerpoint vba 获取形状中的默认文本

powerpoint vba get default text in shape

我的 PowerPoint 幻灯片有一个文本框,其中包含默认文本,例如 "Profile Description",当您单击它时,"Profile Description" 字样会消失,因此您可以输入个人资料。

我想找到特定的文本框,即包含默认文本 "Profile Description" 的文本框,方法是查看文本框的 内容(我找不到使用标题,因为标题可能会有所不同,具体取决于它所在的幻灯片)。

我可以使用 Slide.TextFrame.TextRange 找到此文本的许多其他属性,但我不知道如何获取该默认文本。

单击该框并键入一些文本后,我就可以使用 Slide.TextFrame.TextRange.Text 访问新值,但我需要默认文本。我查看了大量文档,但我想我在某处遗漏了它。请指出正确的方向。谢谢。

那个文本框是从占位符创建的吗?如果是这样,您需要查看与幻灯片关联的自定义布局上的 parent 占位符,由于幻灯片和布局之间 collections 索引的差异以及以下事实,这并非微不足道每次从母版生成幻灯片时,名称 属性 都会更改。示例:

oSld.CustomLayout.Shapes.Placeholders(index).TextFrame2.TextRange.Text

请注意,这适用于自定义文本占位符,但不适用于 built-in 占位符,其中自定义布局上的文本被幻灯片上的 PowerPoint 动态替换。

示例:

幻灯片母版/布局/标题占位符:"Click to edit Master title style"

幻灯片占位符:"Click to add title"

您可以通过使用标签获取对布局上形状的引用。标签是一些不可见的元数据,您可以将其添加到演示文稿、幻灯片或形状中。

这是向幻灯片上的形状添加标签的方法:

ActivePresentation.Slides(1).Shapes(1).Tags.Add myName, myValue

然后,您可以通过其标签将函数写入 return 形状,如下所示:

' *************************************************************************************
' Purpose : Returns a presentation, slide or shape by its tag from a collection of
'           presentations, slides or shapes
' Author  : Jamie Garroch of YOUpresent.co.uk
' Inputs  : TagObject - collection type to be searched. Presentations, Slides or Shapes
'           TagName - The tag name to search for (always upper case)
'           TagValue - The tag value to search for
' Outputs : Returns a Presentation, Slide or Shape object if a match is found
' *************************************************************************************
Public Function GetByTag(TagObject, TagName As String, TagValue As String) As Object
  On Error GoTo errhandler
  Select Case True
    Case TypeOf TagObject Is Presentations
      Dim oPres As Presentation
      For Each oPres In TagObject
        If TagExists(oPres, TagName, TagValue, True) Then Set GetByTag = oPres: Exit Function
      Next
    Case TypeOf TagObject Is Slides
      Dim oSld As Slide
      For Each oSld In TagObject
        If TagExists(oSld, TagName, TagValue, True) Then Set GetByTag = oSld: Exit Function
      Next
    Case TypeOf TagObject Is Shapes
      Dim oShp As Shape
      For Each oShp In TagObject
        If TagExists(oShp, TagName, TagValue, True) Then Set GetByTag = oShp: Exit Function
      Next
  End Select
Exit Function

错误处理程序: DebugMsg "GetByTag Error : " & Err & " " & Err.Description 结束函数

我一直在尝试找到一种方法来使 Tags 能够正常工作,但没成功。

因此,我的解决方案是预先检查占位符的 CustomLayout 并记下顶部的 x、y 坐标以及默认情况下它们应具有的值。

之后,当页面生成后,我通过 x,y 坐标检查形状,如果匹配,则替换为默认值。