根据带有 VBA 的名称将所有形状底部对齐（Powerpoint）

Question

我在 PowerPoint (office 360) 上使用 VBA 对齐形状时遇到问题。

我知道我可以使用 .Shapes.Range.Align msoAlignBottom、msoFalse 但我不明白如何让它与特定的形状名称一起使用，因为我总是出错或什么也没发生。

这是我要执行此操作的代码：


Sub FixFitToShape()
    Dim oSl    As Slide
    Dim sn As String
    Dim oSh    As Shape

    sn = InputBox("Enter the name of the shape")
    On Error Resume Next
    
    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If oSh.Name = sn Then
                Select Case oSh.PlaceholderFormat.Type
                Case 1, 3 'Title
                    oSh.TextFrame2.AutoSize = msoAutoSizeTextToFitShape ' OR msoAutoSizeNone
                Case 2, 7 'Text / Content
                    oSh.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                
                    oSh.Shapes.Range.Align msoAlignBottom, msoTrue

                End Select
            End If
            
        Next oSh
    Next oSl
End Sub

非常感谢您的帮助，

Answer 1

试试这个代码：

Sub FixFitToShape()
    Dim oSl    As Slide
    Dim sn As String
    Dim oSh    As Shape

    'sn = InputBox("Enter the name of the shape")
    sn = "Name1"    'debug
    'On Error Resume Next
    
    For Each oSl In ActivePresentation.Slides
        For i = 1 To oSl.Shapes.Count
            Set oSh = oSl.Shapes(i)
            If oSh.Name = sn Then
                Select Case oSh.Type    'placeholder or not placeholder?
                    Case msoPlaceholder
                        ' it's a placeholder! check the placeholder's type
                        If oSh.PlaceholderFormat.Type = ppPlaceholderTitle _
                            Or oSh.PlaceholderFormat.Type = ppPlaceholderCenterTitle Then
                            'do smth with placeholder
                            oSh.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
                        End If
                    Case Else   'it's not a placeholder
                        oSh.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                        oSl.Shapes.Range(i).Align msoAlignBottoms, msoTrue 'align it to bottom of the slide
                End Select
            End If
        Next
    Next oSl
End Sub

我还建议删除 On Error Resume Next 语句，因为它隐藏了错误并且您无法获得有关代码工作原理的有用信息。

Answer 2

您必须创建一个包含要对齐的形状的 ShapeRange。由于您键入的是形状的名称，下面的示例显示了如何使用通配符。

Option Explicit

Sub Test()
    LineUpShapes 1, "Rectangle", msoAlignTops
End Sub

Sub LineUpShapes(ByVal SlideNumber As Long, _
                 ByVal ShapeName As String, _
                 ByVal alignment As MsoAlignCmd)
    Dim sl As Slide
    Set sl = ActivePresentation.Slides(SlideNumber)
    
    Dim namedShapes() As Variant
    Dim shapeCount As Integer
    Dim sh As Shape
    For Each sh In sl.Shapes
        If sh.Name Like (ShapeName & "*") Then
            shapeCount = shapeCount + 1
            ReDim Preserve namedShapes(shapeCount) As Variant
            namedShapes(shapeCount) = sh.Name
            Debug.Print "shape name " & sh.Name
        End If
    Next sh
    
    Dim shapesToAlign As ShapeRange
    Set shapesToAlign = sl.Shapes.Range(namedShapes)
    shapesToAlign.Align alignment, msoFalse
End Sub

Answer 3

非常感谢 Алексей！

我已经重新修改了你的代码，它运行得很好！在我的例子中它始终是一个占位符 ;)

Sub FixFitToShape()
    Dim oSl    As Slide
    Dim sn As String
    Dim oSh    As Shape

    sn = InputBox("Enter the name of the shape")
  
    
    For Each oSl In ActivePresentation.Slides
      For i = 1 To oSl.Shapes.Count
            Set oSh = oSl.Shapes(i)
            If oSh.Name = sn Then
                Select Case oSh.PlaceholderFormat.Type
                Case 1, 3 'Title
                    oSh.TextFrame2.AutoSize = msoAutoSizeTextToFitShape ' OR msoAutoSizeNone
                Case 2, 7 'Text / Content
                  oSh.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                  oSl.Shapes.Range(i).Align msoAlignBottoms, msoTrue 'align it to bottom of the slide
     
                End Select
            End If
            
        Next
    Next oSl
    
End Sub

根据带有 VBA 的名称将所有形状底部对齐（Powerpoint）

Align bottom all shapes according to a name with VBA (Powerpoint)

vba

alignment

powerpoint