How do I write a Visio macro operating on a selection?

[Staffan Cronstrom]

I want to write (create) a macro in VISIO that operates on selected objects.
What I mean is the following:
I want to create a macro that e.g.
* sets the line weight to 0.35mm
* sets the line pattern "fine dashed", pattern n 9 in Format/Line
on a shape, or some shapes, I select. I.e.,
* first I would select the shape or shapes
* then I would call the macro
I want all the selected shapes to, after I've done this, have taken on the
line weight of 0.35mm and the line pattern n 9.

 

[John Goldsmith]

Hello Staffan,

You can get hold of the selected shapes as a property of the ActiveWindow
object. Once you have that it's just a case of running through them and
making the changes you're after:

Public Sub ChangeLineFormat()
Dim shp As Shape
Dim sel As Selection
Dim i As Integer

'Set the initial selection
Set sel = ActiveWindow.Selection

'Run through the items in the selection
For i = 1 To sel.Count
Set shp = sel(i)
With shp
.CellsU("LineWeight").FormulaU = "0.35 mm"
.CellsU("LinePattern").FormulaU = "9"
End With
Next i
End Sub

If you're interested in more information on looping code then you might find
this useful:

http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html

Also, have you tried the macro recorder? If you want more on this have a
look at this post:

http://msmvps.com/blogs/visio/archive/2006/03/03/85364.aspx

Best regards

John


John Goldsmith
www.visualSignals.typepad.co.uk
www.visualSignals.co.uk

 

[Staffan Cronstrom]

Hello John,

Thank you very much! _You really answered my question._
I also tried the following variant, which is however suboptimal in the sense
that some items are "computed" once for each object, plus 1; your original
"computing" them only once. It, too, worked.

Sub test1()

For i = 1 To ActiveWindow.Selection.Count
With ActiveWindow.Selection(i)
.CellsU("LineWeight").FormulaU = "0.35mm"
.CellsU("LinePattern").FormulaU = "9"
End With
Next i

End Sub

The "dim i as integer" turns out to be unneccessary, but the "set"-s in your
original must be there.

Best regards

Staffan cronstrom

 

[Staffan Cronstrom]

Once again, thank you.
Maybe you could now tell me how to get the position of a shape (rectangle,
etc.)
What I want to do is the following:

Assume I have two, say, rectangles, both filled; call them A and B. A is
partially hidden by B.
I want to
* create a copy of A
* change the copy's line pattern to "9" ("fine dahsed")
* change the copy's line weight to "0.25mm" (A has "0.35mm")
* remove the copy's fill, i.e. set the pattern to "00"
* move the copy to front
* center the copy over A

The result of all this would be that the part of A hidden by B is shown
dashed.

How do I do arithmetics on line weights, positions, etc? I.e. assume e.g.
that I want to re-scale a shape's line weight by 0.5. I.e. to 0.25mm if it
was 0.5mm from the beginning, to 0.175mm if it was 0.35mm from the beginning.
How do I do that?

Best regards

Staffan Cronstrom

 

[John Marshall, MVP]

It seems you are at the exploration stage. One good tool for understanding
what is happening is to use the macro recorder.

John... Visio MVP

Need stencils or ideas? http://visio.mvps.org/3rdparty.htm
Need VBA examples? http://visio.mvps.org/VBA.htm
Visio Wishlist http://visio.mvps.org/wish_list.htm

 

[John Goldsmith]

Hello Staffan,

John's right, you should definitely have a go with the macro recorder (see
the link in my original post). Just turn on record and work through your
steps below, click stop and then review the code it produces. You then just
need to translate this into the selection reference as per my previous code.

Regarding your last question you could get the current line weight, assign
it to a variable, divide by two to give you 50%, and then set the shape's
line weight again using the variable. Something like this:

Dim shp As Shape
Dim dblMyLineWeight As Double

dblMyLineWeight = shp.CellsU("LineWeight").ResultIU / 2
shp.CellsU("LineWeight").FormulaU = dblMyLineWeight

Best regards

John


John Goldsmith
www.visualSignals.typepad.co.uk
www.visualSignals.co.uk

 

[Staffan Cronstrom]

Hello John,

"...Just turn on record and work through your
steps below, click stop and then review the code it produces...":
No, that's not fully true. That is what I tried first to do the line-weight
setting to 0.35mm. The code produced by the MacroRecorder looked _completely
different_ from your brilliant answer.

/Staffan Cronstrom

 

[John Goldsmith]

Ok. As I mentioned, you need to translate the macro code into something
using a reference to the selection.

The macro code for your steps produces this output:

Sub Macro4()

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(3),
visSelect
Application.ActiveWindow.Selection.Copy

Application.ActiveWindow.Page.Paste

Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Line Properties")
Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowLine, visLineWeight).FormulaU = "0.25 mm"
Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowLine, visLinePattern).FormulaU = "9"
Application.EndUndoScope UndoScopeID1, True

Dim UndoScopeID2 As Long
UndoScopeID2 = Application.BeginUndoScope("Fill Properties")
Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowFill, visFillPattern).FormulaU = "0"
Application.EndUndoScope UndoScopeID2, True

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(4),
visSelect
Application.ActiveWindow.Selection.Move -0.984252, 0.590551

End Sub


A few obsevations:

a) the long lines will probably be wrapped when you view them in the
newsgroup, so just bear that in mind.

b) each instruction set is enclosed by an UndoScope (which adds them to the
Undo queue). Not required for our purposes here.

c) virtually all actions are based on single instructions with the full
reference back to the Application object which is the main part we need to
translate.


So lets strip out the Undo parts first of all to make things a bit clearer:

Sub Macro4()

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(3),
visSelect
Application.ActiveWindow.Selection.Copy

Application.ActiveWindow.Page.Paste

Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowLine, visLineWeight).FormulaU = "0.25 mm"
Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowLine, visLinePattern).FormulaU = "9"

Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowFill, visFillPattern).FormulaU = "0"

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(4),
visSelect
Application.ActiveWindow.Selection.Move -0.984252, 0.590551

End Sub


Next, as we're dealing with two shapes we'll declare two variables for them
and then we can use them as our shape references:

Sub Macro4()

Dim shpOriginal As Shape
Dim shpCopy As Shape

'Assign first shape
Set shpOriginal = ActiveWindow.Selection.PrimaryItem

'Check something was actually selected
If Not shpOriginal Is Nothing Then
'Copy the shape to the clipboard using
'the ...NoTranslate flag to keep its
'original coordinates
shpOriginal.Copy (visCopyPasteNoTranslate)

'Paste and the original shape and assign it to
'the copy shape variable.
ActivePage.Paste (visCopyPasteNoTranslate)
Set shpCopy = ActiveWindow.Selection.PrimaryItem

'Now you have a reference to your new shape
'carry out whatever operations you want to make
With shpCopy
.CellsSRC(visSectionObject, visRowLine, _
visLineWeight).FormulaU = "0.25 mm"
.CellsSRC(visSectionObject, visRowLine, _
visLinePattern).FormulaU = "9"
.CellsSRC(visSectionObject, visRowFill, _
visFillPattern).FormulaU = "0"
'BringToFront isn't really necessary as
'shpCopy was the last shape to be dropped
'on the page, but it's a method of the
'shape object if you're interested
.BringToFront
End With
Else
MsgBox "Please select a shape.", vbOKOnly, "No shape selected"
End If

End Sub

Best regards

John


John Goldsmith
www.visualSignals.typepad.co.uk
www.visualSignals.co.uk