Location or Position of any object

Hi John,

Using the similar fashion below, please help me with a code that can pickup location or position of any object on the ppt slide and apply that to another object on the same slide or any other slide.

Code:

---

Dim adj() As Single
Sub PickUp_Ang_Adj()
    Dim oshp As Shape
    Dim i As Integer
On Error Goto err:
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    Redim adj(1 To oshp.Adjustments.Count)
    For i = 1 To oshp.Adjustments.Count
        adj(i) = oshp.Adjustments(i)
    Next i
    Exit Sub
err:
    MsgBox "Select Shape"
End Sub
 
Sub Apply_Ang_Adj()
    Dim oshp As Shape
    Dim i As Integer
On Error Goto err:
    For Each oshp In ActiveWindow.Selection.ShapeRange
        Redim Preserve adj(1 To oshp.Adjustments.Count)
        For i = 1 To oshp.Adjustments.Count
            oshp.Adjustments(i) = adj(i)
        Next i
    Next oshp
    Exit Sub
err:
    MsgBox "ERROR"
End Sub

---

- Thanks

OK time to start coding yourself!

Start by adding two more variables at the top of the code (based on the format code you already have)

Dim sngW As Single
Dim sngH As Single
Dim lngRot As Long
Dim sngL as Single
Dim sngT as Single

Use the two new variable to store and apply the oshp.Left and oshp.Top in the same way as Width and Height.

You can do it!

wow, thanks John, got the required output.

Maybe post the code to help others.

Here is the code I used to get the result.

Dim sngL As Single
Dim sngT As Single


Sub Get_Loc()
Dim oshp As Shape
On Error GoTo err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.PickUp
sngL = oshp.Left
sngT = oshp.Top
Exit Sub
err:
MsgBox "Select Shape"
End Sub


Sub Set_Loc()
Dim oshp As Shape
On Error GoTo err:
For Each oshp In ActiveWindow.Selection.ShapeRange
oshp.Apply
oshp.LockAspectRatio = False
oshp.Left = sngL
oshp.Top = sngT
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub

That's good

You don't NEED to lock aspect ratio as you are not resizing but it won't do any damage! Pick Up and Apply will pick up and apply other things like fill etc They can be deleted if you don't need this.