Copy Shape to another shape or more with a click

Hi John, I've tried to adapt your following code to be one Module, and not two:

Public sngW As Single
Public sngH As Single
Public lngRot As Long
Public lngType As Long




Sub CopyShape1()
Dim oShp As Shape
On Error GoTo err:
Set oShp = ActiveWindow.Selection.ShapeRange(1)
oShp.PickUp
sngW = oShp.Width
sngH = oShp.Height
lngRot = oShp.Rotation
lngType = oShp.AutoShapeType
Exit Sub
err:
MsgBox "Please Select a Shape"
End Sub

Sub ChangeShape2()

Dim oShp As Shape
On Error GoTo err:
For Each oShp In ActiveWindow.Selection.ShapeRange
oShp.AutoShapeType = lngType
oShp.Apply
oShp.LockAspectRatio = False
oShp.Width = sngW
oShp.Height = sngH
oShp.Rotation = lngRot
Next oShp
Exit Sub
err:
MsgBox "Select a Shape first, or try again starting with the Copy Shape tool"
End Sub


But my code fails when I try to make it work with one button... so, say you have a triangle with text and you want to click a few squares to turn into that matching triangle, I'm hoping this tool would do it. Much like the Format Painter, but it takes the Shape and its colors too. Thank you.

Here is my poor effort:

Public sngW As Single
Public sngH As Single
Public lngRot As Long
Public lngType As Long


Sub ApplyMyShape1()
Dim oShp As Shape
On Error GoTo err:
Set oShp = ActiveWindow.Selection.ShapeRange(1)
oShp.PickUp
sngW = oShp.Width
sngH = oShp.Height
lngRot = oShp.Rotation
lngType = oShp.AutoShapeType
Exit Sub
err:
MsgBox "Please Select a Shape"
On Error GoTo err:
For Each oShp In ActiveWindow.Selection.ShapeRange
oShp.AutoShapeType = lngType
oShp.Apply
oShp.LockAspectRatio = False
oShp.Width = sngW
oShp.Height = sngH
oShp.Rotation = lngRot
Next oShp
Exit Sub
End Sub

Thank you.

You need to explain exactly the steps you want to take and exactly what you want to happen.

Hi John, it's where an object you click will transfer its size and colour / fonts to any shape clicked afterwards. It works as two buttons, but I can't figure how to merge into one button. The first code is yours for 2 buttons, the red code is mine that fails to be one button.

So if I click a Yellow Diamond 3cm x 10cm, Arial 10, say, then each shape I click afterwards will become the same shape / size / font?

Thank you.

That wouldn't be easy. You would have to program a toggle button into the ribbon and I doubt you know how to do that. It's not something I can easily explain either. I would stick with the two button solution

Thanks :thumb