根据名称使用 VBA（Powerpoint）将所有形状底部对齐答案

【问题标题】：Align bottom all shapes according to a name with VBA (Powerpoint)根据名称使用 VBA（Powerpoint）将所有形状底部对齐
【发布时间】：2021-08-06 23:13:58
【问题描述】：

我在 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

非常感谢您的帮助，

【问题讨论】：

请具体说明您要做什么：1) 在每张幻灯片上找到一个图形，并将该幻灯片上的其他图形与您找到的图形对齐，2) 在每张幻灯片上找到相同的所有图形命名并对齐它们，3）将所有幻灯片上的所有同名图形与第一个图形对齐，4）另一个选项
感谢您的回复。我只需要 sn 定义的具有相同名称的每个形状都与其幻灯片的底部对齐。我需要在 msoAutoSizeTextToFitShape 或 msoAutoSizeShapeToFitText 处理之后对齐形状

标签： vba alignment powerpoint

【解决方案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 语句，因为它隐藏了错误并且您无法获得有关代码如何工作的有用信息。

【讨论】：

【解决方案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

【讨论】：

非常感谢 PeterT :)

【解决方案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

【讨论】：