View Single Post
 
Old 09-18-2013, 12:42 AM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,914
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

See if this works Select first the original shape and then the new shape with ctrl and run

Sub SizeAndSwap()
Dim oTarget As Shape
Dim oSource As Shape
Dim sngL As Single
Dim sngT As Single
On Error Resume Next
If ActiveWindow.Selection.ShapeRange.Count = 2 Then
On Error GoTo err
Set oSource = ActiveWindow.Selection.ShapeRange(1)
Set oTarget = ActiveWindow.Selection.ShapeRange(2)
oTarget.Width = oSource.Width
oTarget.Height = oSource.Height
sngL = oTarget.Left
sngT = oTarget.Top
oTarget.Left = oSource.Left
oTarget.Top = oSource.Top
oSource.Left = sngL
oSource.Top = sngT
If MsgBox("Delete original?", vbInformation + vbYesNo) = vbYes Then oSource.Delete
Else
MsgBox "You need to select TWO shapes", vbCritical
End If
Exit Sub
err:
MsgBox "No shapes are selected.", vbCritical
End Sub

Ideally it would need a button permanently on the ribbon to run it and some more error checking. We could do this for you but it would have to go through the books and there would be a small charge.
johnATpptalchemy.co.uk
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials

Last edited by JohnWilson; 09-18-2013 at 02:15 AM.
Reply With Quote