【问题标题】:VBA PowerPoint slide TitleVBA PowerPoint 幻灯片标题
【发布时间】:2015-11-04 17:10:27
【问题描述】:

我正在开发一种自定义工具,该工具可以为给定的演示文稿生成自定义的讲师注释。我在处理演示文稿时遇到问题,其中幻灯片上基本上没有 Title 对象然后我运行代码,它使用 .

双向传递我的 if 语句

我已将代码简化为基础,使其尽可能简单。

我的测试课有一张正常的幻灯片,其中填充了文本占位符,下一张幻灯片是没有标题文本框的徽标幻灯片,只有版权信息和徽标,(这是有问题的幻灯片)然后另一张幻灯片,其中存在标题占位符,但留空。

如何检查单个幻灯片以确保标题占位符存在?

Public Sub GetTitle()
    Dim pres As Presentation    'PowerPoint presentation
    Dim sld As Slide            'Individual slide
    Dim shp As Shape            'EIAG Text Shape
    Dim ShpType As String       'Shape Type
    Dim SldTitle As String      'Slide TITLE

    'Go through each slide object
    Set pres = ActivePresentation
    For Each sld In ActivePresentation.Slides.Range
    On Error Resume Next
        If sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderCenterTitle Or sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderTitle Then
            If sld.Shapes.Title.TextFrame.TextRange <> "" Then
                SldTitle = sld.Shapes.Title.TextFrame.TextRange
                Debug.Print SldTitle & " - Slide: " & CStr(sld.SlideNumber)
            Else
                Debug.Print "BLANK TITLE - Slide: " & CStr(sld.SlideNumber)
            End If
        Else
            ShpType = sld.Shapes.Item(1).Type
            Debug.Print ShpType & "Not Processed There is no Title object"
        End If
    Next sld
End Sub

【问题讨论】:

    标签: vba powerpoint


    【解决方案1】:

    您可以使用 Shapes Collection 的 HastTitle 方法来检查幻灯片是否有标题占位符:

    If sld.Shapes.HasTitle then
    

    您也不应该依赖于标题占位符是形状 1,而是循环遍历幻灯片上的所有形状,按如下方式检查每个形状:

    Option Explicit
    
    ' Function to return an array of title texts from a presentation
    ' Written by Jamie Garroch at http://youpresent.co.uk
    ' Inputs : None
    ' Outputs : Array of title strings
    Function GetTitlesArr() As Variant
      Dim oSld As Slide
      Dim oShp As Shape
      Dim iCounter As Integer
      Dim arrTitles() As String
      For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
          With oShp
            If .Type = msoPlaceholder Then
              Select Case .PlaceholderFormat.Type
                Case ppPlaceholderCenterTitle, ppPlaceholderTitle
                  ReDim Preserve arrTitles(iCounter)
                  arrTitles(iCounter) = oShp.TextFrame.TextRange.Text
                  iCounter = iCounter + 1
              End Select
            End If
          End With
        Next
      Next
      GetTitlesArr = arrTitles
    End Function
    

    【讨论】:

    • 这很好用谢谢。我不确定标题是形状 1,我在 MSDN 网站上读到它,所以我认为它是 PowerPoint 的内置功能,但你是对的,比抱歉更安全。如果它准确,或者如果 MS 改变了什么,那么它仍然会执行工作,再次感谢
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-09-15
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多