Shape duplication and alignment

[Rosenrot]

Hi Everyone,

I’ve created the macro the purpose of which is to duplicate selected shape and then transform it into small red box. However, I would like to enhance it a little bit by aligning two boxes - it would be great to have the small red box always in the bottom left corner of initially selected shape. Is it possible to have all of this in one macro?

Sub DuplicateBox()
Dim osld As Slide
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Select
With oshp.Duplicate
.Fill.ForeColor.RGB = RGB(204, 0, 0)
.Line.Visible = False
.Width = 5.6692913386
.Height = 5.6692913386

End With
End Sub

[John Wilson]

Maybe this is what you mean. You probably need to explain why you chose the strange size for the red box. 7.2 would be 0.1 inch.




Sub DuplicateBox()
Dim oshp As Shape
on error resume next
Set oshp = ActiveWindow.Selection.ShapeRange(1)
if not oshp is nothing then
With oshp.Duplicate
.Fill.ForeColor.RGB = RGB(204, 0, 0)
.Line.Visible = False
.Width = 5.6692913386
.Height = 5.6692913386
.Left = oshp.Left + oshp.Width - .Width
.Top = oshp.Top + oshp.Height - .Height
End With
end if
End Sub

[RandomGerman]

Sometimes I still feel like a beginner, and I'm definitely not a world class coder, so one of those may correct me, if this one's not good enough:


Sub DuplicateBox()
Dim osld As Slide
Dim oshp As Shape

On Error GoTo err

Set oshp = ActiveWindow.Selection.ShapeRange(1)
With oshp.Duplicate
.Fill.ForeColor.RGB = RGB(204, 0, 0)
.Line.Visible = False
.Width = 5.6692913386
.Height = 5.6692913386
.Left = oshp.Left
.Top = (oshp.Top + oshp.Height) - 5.6692913386
End With
Exit Sub

err:
MsgBox "Please select a shape"
End Sub

[RandomGerman]

Oh, John was quicker. He's the expert, so take his version. ;)

[John Wilson]

Except my original code is bottom Right corner (i misread it) Mr German's code work just fine



Sub DuplicateBox()
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)

With oshp.Duplicate
.Fill.ForeColor.RGB = RGB(204, 0, 0)
.Line.Visible = False
.Width = 5.6692913386
.Height = 5.6692913386
.Left = oshp.Left
.Top = oshp.Top + oshp.Height - .Height
End With

End Sub

[Rosenrot]

Thank you guys for your help, both macros work just perfectly! :)