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

在大多数情况下，不会有多个给定类型（例如标题、副标题等）的母版/布局占位符，因此您可以将幻灯片形状的占位符类型与幻灯片布局的占位符类型相匹配。这是一些示例 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

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

显然，母版幻灯片中占位符/文本框架上设置的标签或替代文本的任何属性都不会转移到基于母版的幻灯片中。因此，认为 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

这是对我有用的解决方案，灵感来自 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