CODEWITHSUNDEEP
vbapowerpoint
victor
victor

Reputation: 5

Powerpoint vba: Apply shape object properties to selection

I want to run a macro that allows for the following steps:

  1. User clicks on shape A and runs macro

  2. Macro will record position and size properties of shape A

  3. User clicks on Shape B on a different slide

  4. Macro applies position and size properties of shape A to shape B
  5. User clicks on Shape C on a different slide
  6. Macro applies position and size properties of shape A to shape C etc...

So far I have been able to get the initial shape (Shape A's) properties, but am not sure how to let the user select the next shapes. 

Dim w As Double
Dim h As Double
Dim l As Double
Dim t As Double

With ActiveWindow.Selection.ShapeRange(1)
    w = .Width
    h = .Height
    l = .Left
    t = .Top
End With

Appreciate the help!

See below for answer. If you haven't used forms before (like myself), the code that begins with "Private Sub CommandButton1_Click()" should NOT be inserted in the same module. Go to Insert > Userform, then drag two command buttons onto the UI box, and another "Userform code" window should appear. That new window is where the "Private Sub CommandButton1_Click()" code should go.

Upvotes: 0

Views: 4746

Answers (2)

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

One approach would be along these lines:

In a module:

Public aShapes() As Shape

Sub RecordShapes()

    ReDim aShapes(1 To 1)
    Dim x As Long

    Set aShapes(1) = ActiveWindow.Selection.ShapeRange(1)

    ' the modeless form will allow the user to move from slide to slide
    ' selecting shapes as they wish
    UserForm1.Show vbModeless

End Sub

On the form, two buttons; one to add the currently selected shape to the array of shapes you're collecting, another to apply the parms of the first shape to the add'l selected shapes.

Private Sub CommandButton1_Click()

    ReDim Preserve aShapes(1 To UBound(aShapes) + 1)
    Set aShapes(UBound(aShapes)) = ActiveWindow.Selection.ShapeRange(1)

End Sub
Private Sub CommandButton2_Click()

    Dim x As Long
    For x = 2 To UBound(aShapes)
        aShapes(x).Left = aShapes(1).Left
        aShapes(x).Width = aShapes(1).Width
        ' etc
    Next

End Sub

You'll need to add error checking to make sure that SOMETHING is selected when the user clicks any of the buttons, that they've added at least one shape to the array after choosing the first shape, and you might want to deal with multiple selected shapes as well.

Upvotes: 1

Byron Wall
Byron Wall

Reputation: 4010

I think you will have trouble using click events for this. I would recommend creating macros and storing them on the Quick Access Toolbar. Once there, the keyboard shortcut is ALT+SOME NUMBER which can be quickly used.

For the code, the general idea is that you create the variables with global scope. This allows them to retain their values after the Sub finishing execution.

In the code below, StoreDetails will save, and OutputDetails will apply to newly selected object. The saved info will stay there so you can go from A to save and then apply to B, C, D without seeing A again.

Code inside Module1

Dim w As Double
Dim h As Double
Dim l As Double
Dim t As Double

Sub StoreDetails()
    With ActiveWindow.Selection.ShapeRange(1)
        w = .Width
        h = .Height
        l = .Left
        t = .Top
    End With
End Sub

Sub OutputDetails()
    With ActiveWindow.Selection.ShapeRange(1)
        .Width = w
        .Height = h
        .Left = l
        .Top = t
    End With
End Sub

Here is an article about assigning macros to the Quick Access Toolbar if you need help there.

Upvotes: 0

Related Questions