選擇一個範圍內的形狀並對齊它們

Question

我想寫一個函數，我可以在其中選擇一個形狀，之後宏將所有形狀在所選形狀的「短距離」內對齊。

所以我寫了下面的代碼，選擇範圍內的所有對象：

Sub Shape_Dimensions() 

Dim L As Long 
Dim T As Long 
Dim H As Long 
Dim W As Long 

With ActiveWindow.Selection 
    If .Type = ppSelectionShapes Then 
     L = .ShapeRange.Left 
     T = .ShapeRange.Top 
     H = .ShapeRange.Height 
     W = .ShapeRange.Width 
    Else 
     MsgBox "You have not selected an OBJECT in PowerPoint to dimension." 
     Exit Sub 
    End If 
End With 

'Set range for selection 
TopRange = L + 30 
DownRange = T + H + 20 
'Left and right are 0 - 600 

End Sub 

現在最後一步我想利用的是選擇都是頂級的範圍和下範圍內的所有形狀和它們對齊與選定框的頂部。有關我應該如何繼續的任何想法？

Answer 1

Sub Shape_Align() 

    Dim L As Long 
    Dim T As Long 
    Dim H As Long, TopRange As Long, DownRange As Long 
    Dim W As Long, s As Shape, n As String 

    With ActiveWindow.Selection 
     If .Type = ppSelectionShapes Then 
      L = .ShapeRange.Left 
      T = .ShapeRange.Top 
      H = .ShapeRange.Height 
      W = .ShapeRange.Width 
      n = .ShapeRange.Name 
     Else 
      MsgBox "You have not selected an OBJECT in PowerPoint to dimension." 
      Exit Sub 
     End If 
    End With 

    'Set range for selection 
    TopRange = L + 30 
    DownRange = T + H + 20 
    'Left and right are 0 - 600 

    For Each s In ActiveWindow.View.Slide.Shapes 
     If s.Name <> n Then 
      'in scope for lining up? 
      If Abs(s.Top - T) < 60 Then 
       s.Top = T 
      End If 
     End If 
    Next s 

End Sub