Which field is that cow in?

I reader of one of my earlier posts, Copy Data from one Shape to Another ( see http://davidjpp.wordpress.com/2009/02/02/copying-data-from-one-shape-to-another/ ) asked how a cow can inherit the field number of from the field that it in. I think that this is just an example of how you can automatically update any Shape Data value from an underlying container, but I will use a cow in a field example anyway. This example uses VBA code, but should be good to use in any version of Visio since Visio 2000.

I created a field shape, actually just a filled green rectangle with a brown dash line, with a single Shape Data row, Prop.FieldName. I also created a cow shape from Clip Art, and added two Shape Data rows, Prop.Name and Prop.InField. I also added an optional third Shape Data row, Prop.Quadrant, to add extra precision, if required.

So that you can easily see what the value is in the Prop.Name and Prop.InField rows, I inserted a custom formula into the text of the Cow shape:

=Prop.Name & IF(STRSAME(Prop.InField,”"),” is not in a field”,” is in quadrant ” & Prop.Quadrant & ” of the “& Prop.InField & ” field”)

Thus, you can see which field the cow is in, and even which part of the field.

image

Obviously, you can type in the name (and quadrant) of the field that the cow is in, but you want it to update automatically whenever a cow is dropped into a field; moved between fields; moved out of any field; or even if the name of the field is changed.  To do this, I added a formula in the EventXFMod cell of the Events section of the Cow shape.

image

The formula is:

=CALLTHIS(“GetContainerProp”,,”Prop.InField”,”Prop.FieldName”, “Prop.Quadrant”)

This is a call to the GetContainerProp macro with the parameters Prop.InField , Prop.FieldName and Prop.Quadrant.

The VBA method, GetContainerProp , is based on the ListShapesThatContain example in the Shapes \ Spatial Neighbor List in the Visio SDK Code Samples Library.

Public Sub GetContainerProp(ByVal shp As Visio.Shape, _

    ByVal shpProp As String, ByVal containerProp As String, _

    ByVal quadrantProp As String)

    

Dim vsoShapeOnPage As Visio.Shape

Dim intTolerance As Integer

Dim vsoReturnedSelection As Visio.Selection

Dim strSpatialRelation As String

Dim intSpatialRelation As VisSpatialRelationCodes

 

    'Abort if source cell not found

    If shp.CellExistsU(shpProp, Visio.visExistsAnywhere) = 0 Then

        Exit Sub

    Else

        'Remove current formula

        shp.CellsU(shpProp).FormulaForceU = "="""""

        If Not shp.CellExistsU(quadrantProp, Visio.visExistsAnywhere) = 0 Then

            shp.CellsU(quadrantProp).FormulaForceU = "="""""

        End If

    End If

 

    'Initialize string

    strSpatialRelation = ""

 

    'Set tolerance argument

    intTolerance = 0

 

    'Set Spatial Relation argument

    intSpatialRelation = visSpatialContainedIn + visSpatialTouching + visSpatialOverlap

 

    'Get the set of spatially related shapes

    'that meet the criteria set by the arguments.

    Set vsoReturnedSelection = shp.SpatialNeighbors _

        (intSpatialRelation, intTolerance, 0)

 

    'Evaluate the results.

    If vsoReturnedSelection.Count = 0 Then

        'No shapes met the criteria set by

        'the arguments of the method.

    Else

        'Check each shape in the selection

        For Each vsoShapeOnPage In vsoReturnedSelection

            'Abort if target cell not found

            If Not vsoShapeOnPage.CellExistsU(containerProp, _

                    Visio.visExistsAnywhere) = 0 Then

                'Check that the source Pin is over the container

                If vsoShapeOnPage.HitTest(shp.Cells("PinX").ResultIU, _

                        shp.Cells("PinY").ResultIU, 0) Then

                    shp.CellsU(shpProp).FormulaForceU = _

                        "=GUARD(" & vsoShapeOnPage.NameID & "!" & containerProp & ")"

                    'Enter formula in the optional quadrant cell

                    If Not shp.CellExistsU(quadrantProp, Visio.visExistsAnywhere) = 0 Then

                        shp.CellsU(quadrantProp).FormulaForceU = _

                            "=GUARD(RECTSECT(" & vsoShapeOnPage.NameID & "!Width, " & _

                                vsoShapeOnPage.NameID & "!Height," & _

                                "PinX - (" & vsoShapeOnPage.NameID & "!PinX - " & _

                                    vsoShapeOnPage.NameID & "!LocPinX + " & _

                                    vsoShapeOnPage.NameID & "!Width * 0.5 ), " & _

                                "PinY - (" & vsoShapeOnPage.NameID & "!PinY - " & _

                                    vsoShapeOnPage.NameID & "!LocPinY + " & _

                                    vsoShapeOnPage.NameID & "!Height * 0.5) , 0 ))"

                    End If

                    Exit For

                End If

            End If

        Next vsoShapeOnPage

    End If

 

End Sub

This code works by utilizing the Shape.SpatialNeighbors property to get a list of the shapes that the cow is contained in; touching or overlapping (these are the Relation parameter). Each shape in this list is checked to see if has the required container cell, and, if it does, the Shape.HitTest method is used to check that the feet of the cow (its PinX and PinY) are in the field. To have a closer approximation of the cows feet position, and changed the LocPinY of the cow shape to be Height*0.

image

It is worth noting that the default for the SpatialNeighbors property is to include Visible geometry sections, and in the case of the imported Clip Art image that I used, it worked because a Geometry section existed with Geometry1.NoShow = FALSE, even though there is no fill or lines.

image

Note that the quadrant numbers for the RECTSECT() function start on the right, then increase anticlockwise:

image

There two cases that are not covered by my example, namely, when a field is deleted or moved away from any cows that are in it. The latter case can be handled by fixing the PinX and PinY of the Cow to be relative to the underlying field, but the former case needs code to react to the missing field. This can be done, but is beyond the scope of this post. In any case, I would recommend using events in an Add-In (usually vb.net or C#) for a more complete and robust solution, since lots of simultaneous individual calls with CALLTHIS() in VBA will degrade performance at some point.

Download the example Visio file from http://cid-3350d61bc93733a9.office.live.com/self.aspx/Blogs/WhichFieldIsTheCowIn.vsd

How to Run VBA Macros from a Ribbon Button in Visio 2010

A colleague, who is an experienced Visio tutor, asked me how to hook VBA macros to the Fluent UI Ribbon. He figured that it must\should be easy, but he can’t see where it is done. Well, this question has resonance because a plea was made to the Microsoft Visio team at our recent MVP Conference that this often asked for feature should be made easy for the macro developer. Now, I must admit that I have been so busy writing .Net Visio Add-Ins and following the pattern for the Fluent UI in VSTO C# code, that I had not appreciated just how convoluted the calling of VBA from a Ribbon button is. So, I thought I would offer a way of doing this in a simple (I hope!) way.

I will show how this can be done for a Visio drawing or template that contains VBA macros, and how this can be also be used for a Visio stencil that contains the code. I know that some macro developers put their code into drawings, but I would always recommend putting the code into a stencil, if the code is to be used by multiple drawings.

The Visio team’s Insight Blog has some useful background at http://blogs.msdn.com/b/visio/archive/2010/02/24/user-interface-extensibility-in-visio-2010.aspx , but it only has one fleeting mention of VBA macros:

For VBA, you simply provide the contents of a RibbonX XML as a string directly to Visio through the CustomUI property.

So, what does that mean? How do you actually do it?

Well, there is some sample code in the Visio SDK, which can be downloaded from http://msdn.microsoft.com/en-us/library/ff758690.aspx

I used this code as a starting point to develop my classes and module that I have included in the download ( see https://skydrive.live.com/redir.aspx?cid=3350d61bc93733a9&resid=3350D61BC93733A9!2388&parid=3350D61BC93733A9!197 ) for this article. The principle is that the opening of the document will load the custom UI, which will then be removed when the document is closed. I have included the public subs LoadRibbon and UnloadRibbon so that you can set the UI without closing and opening the document repeatedly.

The only change that is required to the code if it is moved into a stencil, id for the ThisDocument parameters to be replaced with Nothing. This will have the effect of enabling any code that is in the stencil whilst it is open. Of course, code in the stencil can be used for any open drawings.

There are four areas in the Fluent UI that can call VBA code:

  • The Ribbon
  • The Backstage View
  • The Context Menus
  • The Commands

I have provided an example for each. If you want to read about the principles of Fluent UI design, then you could start here http://msdn.microsoft.com/en-us/library/cc872782.aspx , but I am only showing basic buttons in this example. Feel free to expand the range of controls to suit your requirements…

Another useful resource is Office 2010 Help Files : Office Fluent User Interface Control Identifier at http://www.microsoft.com/downloads/en/details.aspx?familyid=3F2FE784-610E-4BF1-8143-41E481993AC6&displaylang=en . This is a series of Excel files that list all of the built-in control Ids for all of the Microsoft Office documents, and one of them, VisioControls.xlsx, lists those for Visio.

I decided to create some methods in the CustomUI module to return XML snippets for various parts of XML string required to build the Ribbon xml:

I included carriage return line feeds (vbCrlf) and tabs (vbTab) in the XML to make it easier to understand.

All of these XML snippets are called from the getRibbonXML method, so you only need to edit this function to modify the UI. In fact, I have included four parameters in the header of getRibbonXML to make it easier to switch on/off each of the four Fluent UI elements:

Private Function getRibbonXML(ByVal includeCommands As Boolean, _  ByVal includeRibbonTab As Boolean, ByVal includeBackstage As Boolean, _  ByVal includeContextMenus As Boolean) As String

This function is called from IRibbonExtensibility_GetCustomUI method in the Ribbon class.

The Ribbon

You can add groups to existing tabs in the ribbon, but you will most probably want to add your own tab with groups and buttons on it. In my example, I have created a new tab, labeled Custom Ribbon Tab, with a single group, labeled Custom Group, containing a large button, Macro 1; two small buttons, Macro 2 and Macro 3; and a split button, Macro 4.

In fact, the split button contains two menu items, Macro 4 and Macro 5.

All of the buttons have an icon, see the Office 2010 Add-In : Icons Gallery at http://www.microsoft.com/downloads/en/details.aspx?displaylang=en&FamilyID=2d3a18a2-2e75-4e43-8579-d543c19d0eed , and each has a supertip (a longer description) that is displayed on mouse over. Note that the FriendlyName, My custom Fluent UI, is entered in the CustomUIStart method in the CustomUI module.

The code that creates this button can be found in getRibbon method of the Ribbon class:

        'Open the Ribbon element
        strGetRibbonXML2 = getRibbonBegin
        'Open the Tab element
        strGetRibbonXML2 = strGetRibbonXML2 & getTabBegin(False, "tab1", "Custom Ribbon Tab")
        'Open the Group element
        strGetRibbonXML2 = strGetRibbonXML2 & getGroupBegin(False, "group1", "Custom Group")
        'Add custom buttons as required
        strGetRibbonXML2 = strGetRibbonXML2 & getButton( _
            "customMacro1", "Macro 1", "This is macro 1", "GroupSynchronizeWithSite", True)
        strGetRibbonXML2 = strGetRibbonXML2 & getButton( _
            "customMacro2", "Macro 2", "This is macro 2", "GroupViewsInfoPath", False)
        strGetRibbonXML2 = strGetRibbonXML2 & getButton( _
            "customMacro3", "Macro 3", "This is macro 3", "PostReply", False)
        'Open the split button element
        strGetRibbonXML2 = strGetRibbonXML2 & getSplitButtonBegin("customSplit1")
        'Open the menu element
        strGetRibbonXML2 = strGetRibbonXML2 & getMenuBegin("customMenu1")
        'Add custom buttons as required
        strGetRibbonXML2 = strGetRibbonXML2 & getButton( _
            "customMacro4", "Macro 4", "This is macro 4", "VisioDiagramGallery", False)
        strGetRibbonXML2 = strGetRibbonXML2 & getButton( _
            "customMacro5", "Macro 5", "This is macro 5", "VisioTransparency", False)
        'Close the menu element
        strGetRibbonXML2 = strGetRibbonXML2 & getMenuEnd
        'Close the split button element
        strGetRibbonXML2 = strGetRibbonXML2 & getSplitButtonEnd
        'Close the Group element
        strGetRibbonXML2 = strGetRibbonXML2 & getGroupEnd
        'Close the Tab element
        strGetRibbonXML2 = strGetRibbonXML2 & getTabEnd
        'Close the Ribbon element
        strGetRibbonXML2 = strGetRibbonXML2 & getRibbonEnd

 This produces the XML snippet:

<ribbon>  <tabs>  <tab id="tab1" label="Custom Ribbon Tab">  <group id="group1" label="Custom Group">  <button id="customMacro1" label="Macro 1" supertip="This is macro 1" size="large" imageMso="GroupSynchronizeWithSite" onAction="OnAction"/>  <button id="customMacro2" label="Macro 2" supertip="This is macro 2" imageMso="GroupViewsInfoPath" onAction="OnAction"/>  <button id="customMacro3" label="Macro 3" supertip="This is macro 3" imageMso="PostReply" onAction="OnAction"/>  <splitButton id="customSplit1">  <menu id="customMenu1">  <button id="customMacro4" label="Macro 4" supertip="This is macro 4" imageMso="VisioDiagramGallery" onAction="OnAction"/>  <button id="customMacro5" label="Macro 5" supertip="This is macro 5" imageMso="VisioTransparency" onAction="OnAction"/>  </menu>  </splitButton>  </group>  </tab>  </tabs> </ribbon> 

The Backstage View

I have given an example for two columns in the Backstage View, in a new tab labeled Custom Tab. I have included a large button, labeled BS Macro 1 and; and two normal buttons, labeled BS Macro 2 and BS Macro 3.

The code that creates this button can be found in getRibbon method of the Ribbon class:

 'Open the backstage element  strGetRibbonXML3 = getBackstageBegin  'Open the tab element  strGetRibbonXML3 = strGetRibbonXML3 & getTabBegin(False, "tab2", "Custom Tab")  'Open the column element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageColumnBegin(One)  strGetRibbonXML3 = strGetRibbonXML3 & vbTab & getGroupBegin(False, "group2", "Custom Group 2")  strGetRibbonXML3 = strGetRibbonXML3 & getBackstagePrimaryItemBegin  'Add custom buttons as required  strGetRibbonXML3 = strGetRibbonXML3 & vbTab & vbTab & getButton( _ 
 "customBMacro1", "BS Macro 1", "This is bs macro 1", "GroupSynchronizeWithSite", False)  'Close the primaryitem element 
 strGetRibbonXML3 = strGetRibbonXML3 & getBackstagePrimaryItemEnd
 'Close the group element  strGetRibbonXML3 = strGetRibbonXML3 & vbTab & getGroupEnd  'Close the column element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageColumnEnd(One)  'Open the column element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageColumnBegin(Two)  'Open the group element  strGetRibbonXML3 = strGetRibbonXML3 & vbTab & getGroupBegin(False, "group3", "Custom Group 3")  'Open the topitems element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageTopItemsBegin  'Add custom buttons as required strGetRibbonXML3 = strGetRibbonXML3 & vbTab & vbTab & getButton( "customBMacro2", "BS Macro 2", "This is bsmacro 2", "GroupViewsInfoPath", False) strGetRibbonXML3 = strGetRibbonXML3 & vbTab & vbTab & getButton( "customBMacro3", "BS Macro 3", "This is bsmacro 3", "PostReply", False) 
 'Close the topitems element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageTopItemsEnd  'Close the group element 
 strGetRibbonXML3 = strGetRibbonXML3 & vbTab & getGroupEnd  'Close the column element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageColumnEnd(Two)  'Close the tab element  strGetRibbonXML3 = strGetRibbonXML3 & getTabEnd  'Close the backstage element  strGetRibbonXML3 = strGetRibbonXML3 & getBackstageEnd 

This produces the XML snippet:

 <backstage>
 <tab id="tab2" label="Custom Tab">  <firstColumn>  <group id="group2" label="Custom Group 2">  <primaryItem>  <button id="customBMacro1" label="BS Macro 1" supertip="This is bs macro 1" imageMso="GroupSynchronizeWithSite" onAction="OnAction"/>  </primaryItem>  </group>  </firstColumn>  <secondColumn>  <group id="group3" label="Custom Group 3">  <topItems>  <button id="customBMacro2" label="BS Macro 2" supertip="This is bsmacro 2" imageMso="GroupViewsInfoPath" onAction="OnAction"/>  <button id="customBMacro3" label="BS Macro 3" supertip="This is bsmacro 3" imageMso="PostReply" onAction="OnAction"/>  </topItems>  </group>  </secondColumn>  </tab>  </backstage> 

The Context Menus

The second tab, named contextmenus, of the VisioControls.xlsx Excel workbook lists the possible contexts for the menus. In my example, I have used ContextMenuShape so that the button, labeled My Button, will be available on the Action Menu whenever a 2D shape is selected.

The code that creates this button can be found in getRibbon method of the Ribbon class:

 'Open the context menus group element  strGetRibbonXML4 = getContextMenusBegin  'Open the context menu element 
 'See the contextmenus worksheet in C:\Office 2010 Developer Resources\Documents\Office2010ControlIDs\VisioControls.xlsx 
 strGetRibbonXML4 = strGetRibbonXML4 & getContextMenuBegin("ContextMenuShape")  'Include any menu buttons required  strGetRibbonXML4 = strGetRibbonXML4 & getButton( _  "customContextMacro1", "My Button", "This is my context menu macro", _  "MindMapChangeTopic", False)  'Close the context menu element  strGetRibbonXML4 = strGetRibbonXML4 & getContextMenuEnd  'Close the context menus group element  strGetRibbonXML4 = strGetRibbonXML4 & getContextMenusEnd 

This produces the XML snippet:

 <contextMenus>  <contextMenu idMso="ContextMenuShape">  <button id="customContextMacro1" label="My Button" supertip="This is my context menu macro" imageMso="MindMapChangeTopic" onAction="OnAction"/>  </contextMenu>  </contextMenus> 

The Commands

You can disable or re-purpose built-in commands too. For example, I have provided an example of disabling the Bold button and re-purposing the Copy command …

… so that it runs some custom code:

The code that creates this button can be found in getRibbon method of the Ribbon class:

 'Open the Commands element  strGetRibbonXML1 = getCommandsBegin  'Add Command actions as required  'You can disable commands  strGetRibbonXML1 = strGetRibbonXML1 & getDisableCommand("Bold")  'You can re-purpose commands  strGetRibbonXML1 = strGetRibbonXML1 & getRedirectCommand("Copy")  'Close the Commands element  strGetRibbonXML1 = strGetRibbonXML1 & getCommandsEnd 

This produces the XML snippet:

<commands>  <command idMso="Bold" enabled="false"/>  <command idMso="Copy" onAction="CommandOnAction"/>  </commands> 

Calling Your VBA Code

You may have noticed that the onAction attributes in all of the above XML have the value OnAction or CommandOnAction. I think that centralising the calls for the buttons and the commands like this, makes it easier to follow. I show the OnAction method below, and the CommandOnAction is very similar. So, all you have to do is ensure that you have a Case option for the ID of any control (button) that you have in the Ribbon XML.

Public Sub OnAction(ByVal control As IRibbonControl)
' OnAction
'
' Abstract - This method is a callback specified in the custom UI XML file.
' It is called by Visio when the associated button defined in the XML is pressed.
'
' Parameters
' control The Ribbon UI control that was activated
 ' To execute a VBA macro, use the Document.ExecuteLine method.
 ' For example: Document.ExecuteLine("ThisDocument.HelloWorld");  Select Case control.ID Case "customMacro1"
 'Call to your code
 ThisDocument.ExecuteLine "HelloWorld" Exit Sub Case "customMacro2"
 'Call to your code Case "customMacro3"
 'Call to your code Case "customMacro4"
 'Call to your code Case "customMacro5"  'Call to your code
Case "customContextMacro1"  'Call to your code End Select 
MsgBox control.ID, vbInformation, "OnAction" End Sub

Conclusion

I hope that this provides an easy (well, not quite as easy as I would have liked) way for you to hook your VBA macros into the ribbon.

You have four different areas in the Fluent UI that you can utilise, so, have fun.

Follow

Get every new post delivered to your Inbox.

Join 45 other followers