☰

Powerpoint 幻灯片（形状）似乎没有从主幻灯片继承替代文本

tag-icon • tag-icon vba microsoft-powerpoint
Powerpoint 幻灯片（形状）似乎没有从主幻灯片继承替代文本

我想替换 PowerPoint 幻灯片中的元素，以便了解文档属性变量。我已经安装了宏，而且它有效。

但我不明白为什么基于母版创建的幻灯片没有任何替代文本。母版确实有替代文本。这使我无法循环遍历属性。

我是否遗漏了某个地方的设置？

主模板：

显示替代文本的主模板视图

基于此主布局的幻灯片：

基于母版的幻灯片视图，无替代文本

答案1

在大多数情况下，不会有多个给定类型的主/布局占位符（例如标题、副标题等），因此您可以将幻灯片形状的占位符类型与幻灯片布局的占位符类型进行匹配。以下是一些示例 VBA：

Option Explicit

Sub TestThis()

    Dim osl As Slide
    Dim osh As Shape
    Dim sTemp As String
    
    For Each osl In ActivePresentation.Slides
        For Each osh In osl.Shapes
           sTemp = MasterAltText(osh)
           If Len(sTemp) > 0 Then
                MsgBox sTemp
           End If
        Next
    Next
End Sub

Function MasterAltText(osh As Shape) As String

    Dim osl As Slide
    Dim oMasterShape As Shape
    Dim oLayout As CustomLayout
    
    ' Is this actually a placeholder?
    If Not osh.Type = msoPlaceholder Then
        MasterAltText = ""
    End If
    
    Set osl = osh.Parent
    Set oLayout = osl.CustomLayout
    
    For Each oMasterShape In oLayout.Shapes
        If oMasterShape.Type = msoPlaceholder Then
            If oMasterShape.PlaceholderFormat.Type _
              = osh.PlaceholderFormat.Type Then
                MasterAltText = oMasterShape.AlternativeText
                Exit Function
            End If
        End If
    Next

    MasterAltText = ""

End Function

答案2

我对此进行了一些研究，并且得出结论：将幻灯片母版视为每张幻灯片的“模板”确实不合适。

显然没有任何主幻灯片中占位符/文本框上设置的标签或替代文本的属性会转移到基于主幻灯片的幻灯片中。因此，认为 VBA 代码可以基于标签循环遍历形状是不可能的 - 除非在每张幻灯片中都设置了属性。

我发现一个窍门是使用字体和位置属性。这样，挑选一个形状就相当简单了。

一些事情

    For Each processPage In Application.ActivePresentation.Slides
       For Each shapeobj In processPage.Shapes
           If shapeobj.TextFrame.TextRange.Font.Italic <> 0 Then
               ' found some shape with ITALIC text
               ' do things to it
           End If
 
           ' check against a const with section position
           '  Global Const sectiontop as Double = 27.95
           ' 
           If Round(shapeobj.TextFrame2.TextRange.BoundTop, 2) = sectiontop Then
               ' found shape based on position
               ' do things to it
           End If
        Next  ' shap
    Next 'slide

答案3

这是对我有用的解决方案，受到 Steve Rindsberg 的启发。

我循环遍历与幻灯片关联的主布局中的形状，然后根据形状的一些指纹构建替代文本词典。使用指纹（例如：字体大小、对齐方式、字体颜色……）我可以避免替代文本和标签从主布局转移到幻灯片。

我注意到这只适用于占位符。主幻灯片上的文本框甚至不存在于幻灯片上下文中，因此此处的方法仅在用户不弄乱格式的情况下才有效。

''
''  inspired by
''  https://superuser.com/questions/1719032/powerpoint-slides-shapes-dont-seem-to-inherit-alternative-text-from-master/1719213#1719213
''
Sub updateSlide()


    Dim osl As Slide
    Dim d As Dictionary   ' need reference to MS scripting library
    
    Dim osh As Shape
    Dim sTemp As String
    Dim mykey As String
    
    Set d = Nothing
    
    ' Set d = New Dictionary
    
    ' loop over every slide
    For Each osl In ActivePresentation.Slides
        '
        ' make a dictionary of customtexts in the master
        '
        Set d = makedictionary(osl.CustomLayout)
    
        ' loop over shapes
        ' and find using properties like size / font...
        For Each osh In osl.Shapes
              mykey = makeKEY(osh)
              
              ' if found, do something with this shape.
              If Len(d(mykey)) > 0 Then
                If ActivePresentation.SectionProperties.Count < 1 Then
                   osh.TextFrame.TextRange.Text = "  -  "
                Else
                   ' can also replace with other presentation data.
                   ' 
                   osh.TextFrame.TextRange.Text = ActivePresentation.SectionProperties.Name(osl.sectionIndex)
                End If
              End If
        Next 'shapes
    Next 'slide
End Sub



''
''  make a fingerprint of a shape
''
Function makeKEY(oShape As Shape) As String
    ' return some variables from this one
    ' independent of position !
    ' this is like a "fingerprint" of the shape.
    With oShape.TextFrame.TextRange
        ' choose something that is UNIQUE to the shape
        makeKEY = .Font.Name & .ParagraphFormat.Alignment & .Font.Color & .Font.Italic
    End With
End Function


''
''  make a dictionary of shapes with an alternative text.
''  so we don't have to loop the same objects many times.
''

Function makedictionary(masterslide As CustomLayout) As Dictionary
    ' make a new dict
    Dim d As Dictionary
    Set d = New Dictionary
    Dim mSh As Shape
    
    For Each mSh In masterslide.Shapes
            If Len(mSh.AlternativeText) > 0 Then
               mykey = makeKEY(mSh)
               d(mykey) = mSh.AlternativeText
            End If
    Next
    
    Set makedictionary = d
    Set d = Nothing

End Function

相关内容