Record Macros- Resizing shapes

[Ivan Salas]

Hello all,

I am trying to record a macro by doing the following:

- Start Macro
- View Menu- Size & Position window
- Afterwards, I input the desired width and height.
- Stop Macro

All is well, but afterwards, when I select Run Macro, only the shape from
which I created the Macro changes. I want to be able to create a macro that
will resize ANY shape on the diagram, not only that one.

I would also like to be able to resize many shapes at the same time using
this macro. Is this possible?

Thanks,
Ivan

 

[Philippe C.]

You can do both in one go.
Adapt your macro so that it works with each shape in the Selection.

......
for each shp in ...

next shp

 

[John... Visio MVP]

Hello all,

I am trying to record a macro by doing the following:

- Start Macro
- View Menu- Size & Position window
- Afterwards, I input the desired width and height.
- Stop Macro

All is well, but afterwards, when I select Run Macro, only the shape from
which I created the Macro changes. I want to be able to create a macro
that
will resize ANY shape on the diagram, not only that one.

I would also like to be able to resize many shapes at the same time using
this macro. Is this possible?

Thanks,
Ivan

Record Macro is limited. It will record EXACTLY what ou do and when you play
it back it will do it EXACTLY the same. You need to modify the macro to
handle a more generic case.

The big plus for Record Macro is that it shows you what commands you will
need.

In your case, you will need to replace the reference to the selection. You
original macro should look like
Dim UndoScopeID3 As Long
UndoScopeID3 = Application.BeginUndoScope("Size & Position 2-D")
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormWidth).FormulaU = "55 mm"
Application.EndUndoScope UndoScopeID3, True

Dim UndoScopeID4 As Long
UndoScopeID4 = Application.BeginUndoScope("Size & Position 2-D")
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormHeight).FormulaU = "12 mm"
Application.EndUndoScope UndoScopeID4, True

Step 1. Lose the UNDOs

Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormWidth).FormulaU = "55 mm"
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormHeight).FormulaU = "12 mm"

Step 2: Replace the target

Replace Application.ActiveWindow.Page.Shapes.ItemFromID with
ActiveWindow.Selection

You will end up with
If ActiveWindow.Selection.Count > 0 Then
ActiveWindow.Selection(1).CellsSRC(visSectionObject, visRowXFormOut,
visXFormWidth).FormulaU = "55 mm"
ActiveWindow.Selection(1).CellsSRC(visSectionObject, visRowXFormOut,
visXFormHeight).FormulaU = "12 mm"
End If

The "If ActiveWindow.Selection.Count > 0 Then" is to prevent the macro
running if nothing is selcted. You can add an Else setion to provide a
warning.

John... Visio MVP

 

[Philippe C.]

Are you sure you want to do it with a macro ?
If all the selected shapes are 2D, then you can change width and height in
the Size and Position window.
Ctrl + A selects all the shapes on a page.