Paint Brush but a second one, independent of the first

[StarPig]

Hi, great webiste, just hoping this is possible, I have code for two tools which work separately to PPT's Format Painter (code below):

TOOL A:
Macro 1. Copies a shape's properties (size, colour, font, etc.) to a clipboard that's independent of the Painter or Copy tools - and stores it in memory so you can carry on working, and use later (unless you exit PPT).
Macro 2. Converts a selected object to match the stored properties from 1.

i.e:

Tools A - 2 macros - copy and convert (as detailed below)
Tools B - 2 macros - copy and convert (independent of Tool A)

Is this possible? Thank you.

Macro 1 - TO COPY AND STORE PROPERTIES




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

Sub CopyProperties()
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.PickUp
sngW = oshp.Width
sngH = oshp.Height
lngRot = oshp.Rotation
lngType = oshp.AutoShapeType
Exit Sub



Macro 2 - TO CONVERT AN OBJECT TO STORED PROPERTIES




Sub ConvertProperties()
Dim oshp As Shape
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

[georgiboy]

What happens/ is wrong with the code you have supplied?

[StarPig]

Hi Georgi, sorry, please find the example file attached with the two macros modules.

The slide has two objects - select the first shape, then macro 1 - then click the second shape and use macro 2 - it will convert it to look like the first shape (or any selected).

I'm hoping to have a second one like this so two objects can be stored and reapplied, i.e. macro 1A with macro 1A (as already done) and separately a macro 1B with macro 1B, if that makes sense?

Thank you

[StarPig]

I tried many ways, but failed. Here's the code (I missed off End sub above):

Macro 1:



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


Sub CopyProperties()
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.PickUp
sngW = oshp.Width
sngH = oshp.Height
lngRot = oshp.Rotation
lngType = oshp.AutoShapeType
Exit Sub
End Sub



Converting the selected macro 1 shape's properties to another object selected:



Sub ConvertProperties()
Dim oshp As Shape
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


Thanks in advance.

[georgiboy]

Perhaps the attached will help, i have created a userform that will store the saved properties, once saved you can select another shape then select the property you want from the first listbox in the the userform and then apply that to the new shape.

[StarPig]

Amazing, THANK YOU !!!! Have a great day!