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

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

"Staffan Cronstrom" <StaffanCronstrom@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in
message news:53EE5B21-2590-4BFF-8812-0A97FA660C15@xxxxxxxxxxxxxxxx
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" wrote:

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" <Staffan Cronstrom@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote
in
message news:3AE1EF56-0BF6-437D-A994-5892DBB797F2@xxxxxxxxxxxxxxxx
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 Goldsmith" wrote:

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" <StaffanCronstrom@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote
in
message news:C53D82E3-8931-439B-801A-9463C8F56163@xxxxxxxxxxxxxxxx
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:o 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:o 9.








.

Relevant Pages

  • Re: Moving to next field with F11 in protected document
    ... macro is invoked with a keyboard hotkey and looks at the characters to ... a file with the name of the selection and inserts one space and then ... Dim rgeField As Range ... Dim lngStart As Long ...
    (microsoft.public.word.vba.beginners)
  • Re: Help end the testing tedium please
    ... Dim strFilter As String ... the consolidate button uses this macro (which may be a nightmare to ... With Selection ...
    (microsoft.public.excel.programming)
  • Re: Column Select Mode
    ... > Running a macro always turns off the column select mode. ... > Dim iStartLine As Long ... This is fine for a normal selection, ...
    (microsoft.public.word.vba.general)
  • Re: Transposing data in columns into a single row?
    ... Simply select the range of data from a column and kick off the macro and that data will be moved to consecutive columns. ... If your data selection is something other than a single column, you will be warned with a MessageBox. ... Dim StartRow As Long ... Dim StartCol As Long ...
    (microsoft.public.excel)
  • Re: Open File within a macro
    ... Record a macro when you parse your input file. ... Dim DesktopPath As String ... the code to run the Open file dialogue pointing to any desktop, ... allow the user to make a selection which would then import the text file ...
    (microsoft.public.excel.misc)