Same Measurement - Macro

Sub Same_Measurements()
Dim sr As ShapeRange
Dim s As shape
Dim selectedShape As shape
Dim selectedWidth As Double
Dim selectedHeight As Double

' Get the measurements of the selected object
Set selectedShape = ActiveSelection.shapes(1)
selectedWidth = selectedShape.SizeWidth
selectedHeight = selectedShape.SizeHeight

' Create a new ShapeRange to store matching objects
Set sr = New ShapeRange

' Loop through all shapes in the document
For Each s In ActivePage.shapes.All
If Abs(s.SizeWidth - selectedWidth) < 0.001 And Abs(s.SizeHeight - selectedHeight) < 0.001 Then
sr.Add s ' Add the shape to the ShapeRange if measurements are close enough
End If
Next s

' Select all shapes with equal measurements
sr.CreateSelection

End Sub

This is working well. but when i try the same inside the powerclip not working. can anyone make it work inside the powerclip as well as outside.