0

Background

I add an add-in that did the following thing: For all the powerpoint objects selected (example 4 rectangles), the add-in would resize all objects height and width to match the height and width of the biggest object in the selection.

I tried to write a VBA macro to copy this add-in but nothing happens (adapting the code found in the following question: Powerpoint VBA Macro to copy object's size and location and paste to another object):

Sub test()
    Dim w As Double
    Dim h As Double
    Dim obj As Shape

    w = 0
    h = 0

    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width > w Then
            w = obj.Width
        Else
            obj.Width = w
        End If

        If obj.Height > h Then
            h = obj.Height
        Else
            obj.Height = h
        End If
    Next
End Sub

Question

Any idea on how to make this code works?

Community
  • 1
  • 1
remif
  • 27
  • 2
  • 6

1 Answers1

0

After some more research, here is a code that works (not sure if it is a really efficient one because I am new to VBA):

Sub resizeAll()
    Dim w As Double
    Dim h As Double
    Dim obj As Shape

    w = 0
    h = 0

    ' Loop through all objects selected to assign the biggest width and height to w and h
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width > w Then
            w = obj.Width
        End If

        If obj.Height > h Then
            h = obj.Height
        End If
    Next

    ' Loop through all objects selected to resize them if their height or width is smaller than h/w
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width < w Then
            obj.Width = w
        End If

        If obj.Height < h Then
            obj.Height = h
        End If
    Next
End Sub
remif
  • 27
  • 2
  • 6
  • There are probably a few minor tweaks you could apply to make this more efficient *in theory*. In practice, it's unlikely you'd ever see the difference, though. – Steve Rindsberg Oct 17 '15 at 15:59
  • Thanks for the feedback! (and I used your add-in explanation to add this macro to my ppt). – remif Oct 23 '15 at 07:21