bVisual: Visio

Flags of the World

Sun, 13 Jul 2008 11:33:43 GMT

I was recently asked how to add a country flag to Visio Org Chart shapes automatically. Well, as I am currently working with world data at the moment, I have taken up the challenge. Firstly, the CIA have an excellent source of information, called the World Factbook ( https://www.cia.gov/library/publications/the-world-factbook/ ). You can find all sorts of information about every country in the world, including, of course, their flags. There are over 240 countries at the moment, and there are various codes used by different systems to identify them. Even the name may not be the same, for example, do I live in UK, United Kingdom, Great Britain, United Kingdom of Great Britain and Northern Ireland or just plain old England? Answers on a post card, please, addressed to …..?

Alternatively, a country can be identified accurately with a code, but you need to know which system is being used. United Kingdom can be identified by GB in the Iso 2 character system, or 826 in the Iso numeric system, or UK in the FIPS 10 system. The CIA World Factbook utilises the FIPS 10 code, so consequently, all of the country related web pages and images are coded with this system.

I have already created an Access database with all this information, so I decided to use this knowledge to create a Flags of the World Visio Master.

I wrote some VBA to download the gif files from CIA website, and imported them into a specially prepared group shape. Each image shape was automatically named with the FIPS 10 code, and the Width and Height formulae were written to be 0 if the parent group shape does not represent relevant country.

The ShapeSheet of the parent shape was loaded with semi-colon separated lists of country related data, mainly pulled from the CIA website. The Prop.Country Shape Data row is a fixed list so that the user can select a country by its name. The other Shape Data rows are all guarded because their values are pulled via the Index of selected country name, from the User defined cells.

ShapeSheet of the GB sub-shape, below, showing that the Width and Height is 0, if the shape Name is not equal to the Prop.Fips10 value in the parent shape. Notice that the Width and Height formulae maintain the original aspect ratio of the flag image.

This provides a Flags of the World Master, but I also created a Flags of the World Small Master because the first one uses the large flag images from the CIA website, but the second one uses the small image files, and thus uses less file size.

I have also added context sensitive hyperlinks to the CIA website, Maps Live, Google Maps and Google Earth, and one to bVisual’s website….

OK, now we are halfway there … we actually want to apply the map icon to any shape that has a Shape Data value that is a country name, but we don’t know the name of this Shape Data row in advance….

Visio 2007 Professional Data Graphics has Icon Sets, but you can only have a maximum of 5 icons in each set … certainly not enough for over 240 countries. So, why not use an Icon Set as a placeholder for a country flag, then replace the Icon Set image with the flag for the country whose value is in the Shape Data row specified by the Icon Set Graphic Item?

That is exactly what I did in the screen-shot below:

I duplicated an existing Icon Set (Trend Arrow 1) in the Drawing Explorer, renamed it as FlagPlaceholder, then amended it to have one image sub-shape, called Flag.

Thus the Icon Set becomes available in the Data Graphics editor, and you can select the Shape Data row that contains the name of the country. You only need to have one qualifying value, so I entered does not contain * , because I assume that there is no country in the world with that character in its name.

The attached stencil, FlagsOfTheWorld.vss http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/FlagsOfTheWorld.zip , includes the macro UpdateFlags, which will then change the flag for each selected shape.

So, when the macro is run, the test shapes now show the flags for each country….

Option Explicit
'David Parker
'July 2008
'No warranties at all with this code
'Use at you own risk

Public Sub UpdateFlags()
Dim shp As Visio.Shape
Dim subshp As Visio.Shape
Dim imgshp As Visio.Shape
Dim flagExists As Boolean
Dim cel As Visio.Cell
Dim celPrecedent As Visio.Cell
Dim aryPrecedents() As Visio.Cell
Dim country As String
Dim aryCountries() As String
Dim aryCodes() As String
Dim mstFlag As Visio.Master
Dim code As String
Dim idx As Integer
Dim filePath As String
Dim flagShp As Visio.Shape
Dim shpWidth As Double
Dim shpHeight As Double
Dim shpAspectRatio As Double
Dim flagWidth As Double
Dim flagHeight As Double
Dim flagAspectRatio As Double
Dim cloneShp As Visio.Shape
Dim cloneMst As Visio.Master

On Error Resume Next
    Set mstFlag = ThisDocument.Masters("Flags Of The World")
    If mstFlag Is Nothing Then
        Exit Sub
    Else
        aryCountries = Split(mstFlag.Shapes(1).Cells("Prop.Country.Format").ResultStr(""), ";")
        aryCodes = Split(mstFlag.Shapes(1).Cells("User.Fips10").ResultStr(""), ";")
    End If
    'Need a temporary writeable file need
    'You may need to change this but it needs to be gif extension
    filePath = Replace(Replace(ThisDocument.FullName, ".vss", ".gif"), ".vsd", ".gif")
    'Get the current shape(s)
    For Each shp In Visio.ActiveWindow.Selection
        If Not shp.DataGraphic Is Nothing Then
            For Each subshp In shp.Shapes
                If subshp.CellExists("User.msvCalloutType", Visio.visExistsAnywhere) <> 0 Then
                    If subshp.Cells("User.msvCalloutType").ResultStr("") = "Icon Set" Then
                        'We know that this shape is an Icon Set
                        If subshp.Name = "FlagPlaceholder" Then
                            'We know that the FlagPceholder exists
                            'Get the shape aspect ratio
                            shpWidth = subshp.Cells("Width").ResultIU
                            shpHeight = subshp.Cells("Height").ResultIU
                            shpAspectRatio = shpWidth / shpHeight
                            For Each imgshp In subshp.Shapes
                                If imgshp.Name = "Flag" Then
                                    'Found the Flag shape
                                    Set cel = subshp.Cells("User.msvCalloutIconNumber")
                                    If UBound(cel.Precedents) = 1 Then
                                        'Get the value in the precedent cell
                                        aryPrecedents() = cel.Precedents
                                        Set celPrecedent = aryPrecedents(1)
                                        country = celPrecedent.ResultStr("")
                                        idx = getLookup(country, aryCountries)
                                       If idx > -1 Then
                                            'We found a match for the country name
                                            code = aryCodes(idx)
                                            If Len(Dir(filePath)) > 0 Then
                                                'Clear the temp file
                                                Kill filePath
                                            End If
                                            Set cloneShp = mstFlag.Shapes(1).Duplicate
                                            cloneShp.Cells("Prop.Country").FormulaU = "=""" & country & """"
                                            cloneShp.Shapes(code).Export filePath
                                            cloneShp.Delete
                                            If Len(Dir(filePath)) > 0 Then
                                                'Remove the previous flag
                                                'Temporarily unlock the group
                                                subshp.Cells("LockGroup").FormulaU = 0
                                                imgshp.Delete
                                                Set flagShp = subshp.Import(filePath)
                                                flagShp.NameU = "Flag"
                                                flagShp.Name = "Flag"
                                                'Get the flag aspect ratio
                                                flagWidth = flagShp.Cells("Width").ResultIU
                                                flagHeight = flagShp.Cells("Height").ResultIU
                                                flagAspectRatio = flagWidth / flagHeight
                                                If shpAspectRatio > flagAspectRatio Then
                                                    'Maximise height of flag
                                                    flagShp.Cells("Height").FormulaU = "=" & shp.NameID & "!Height"
                                                    flagShp.Cells("Width").FormulaU = "=Height * " & flagAspectRatio
                                                Else
                                                    'Maximise width of flag
                                                    flagShp.Cells("Width").FormulaU = "=" & subshp.NameID & "!Width"
                                                    flagShp.Cells("Height").FormulaU = "=Width / " & flagAspectRatio
                                                End If
                                                flagShp.Cells("PinY").FormulaU = "=" & subshp.NameID & "!Height*0.5"
                                                flagShp.Cells("PinX").FormulaU = "=" & subshp.NameID & "!Width*0.5"
                                                'Reset the group lock
                                                subshp.Cells("LockGroup").FormulaU = 1
                                                If Len(Dir(filePath)) > 0 Then
                                                    'Clear the temp file
                                                    Kill filePath
                                                End If
                                            End If
                                        End If
                                    End If
                                    flagExists = True
                                    Exit For
                                End If
                            Next
                        End If
                    End If
                End If
                If flagExists = True Then
                    'Move on to the next shape in the selection
                    Exit For
                End If
            Next subshp
        End If
    Next shp
End Sub

Private Function getLookup(ByVal value As String, ByVal aryIn As Variant) As Integer
Dim ary() As String
    ary() = aryIn
Dim i As Integer
Dim found As Boolean
    For i = 0 To UBound(ary)
        If UCase(value) = UCase(ary(i)) Then
            found = True
            Exit For
        End If
    Next
    If found = True Then
        getLookup = i
    Else
        getLookup = -1
    End If
End Function

Note : The following web site was invaluable for helping me download the flag image files from the CIA web-site : http://www.vb-helper.com/howto_download_url_to_file.html

Download files : http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/FlagsOfTheWorld.zip

Enhancing Visio Data Graphics Text Callouts

Thu, 19 Jun 2008 08:39:49 GMT

Visio 2007 Professional introduced the wonderful Data Graphics feature to display Shape Data in a clear visual way, but it is not clear how you may, for example, change the font of even the simplest Graphic Item type, Text Callouts. In this blog, I’ll show you one method that I employ to vary the appearance of Text Callouts. The same technique can be used for other Graphic Item types, Icon Sets and Data Bars.

I am using the the sample IT Asset Management drawing to demonstrate throughout, which can be found in the Samples Template Category. In this diagram, the server shapes on the topology page use the Topology 1 Data Graphic, which can be seen in the Data Graphics panel.

Microsoft had to introduce a new capability in Visio 2007 in order to get Data Graphics working, namely the ability for a shape instance to hold a reference to a DataGraphic master in addition to its normal master. So, if you open the Drawing Explorer window, you can see the normal Server master, in addition to the Topology 1 Data Graphic master. If you open the Topology 1 master, you can see the full Data Graphic, and you can expand the Master Explorer to show that there are multiple shapes inside it. These shapes are the ones that you see displayed in a more friendly way in the Edit Data Graphic dialog.

However, you may also notice that this particular Data Graphic uses the same Text callout Graphic Item multiple times. This is evident if you select Edit Item for Operating System, CPU (MHz), Memory (MB) or IP Address Data Fields in the Edit Data Graphic dialog. In fact, you can only tell which Graphic Item master is being used in the Data Graphic master in code, or by opening the ShapeSheet of each of the sub-shapes.

You can see on the Edit Text dialog that you can edit certain properties, but font is not one of them! SO, how can you edit the font? Well, you could go around each shape in the diagram, sub-select the shapes and change it that way, or you can create a variation of the Text callout Graphic Item master.

In the Drawing Explorer window, select the Text callout master, then Duplicate on its right mouse menu. You can then rename the new Text callout.xxx as whatever you like (I have used Text callout A).

Once you have a copy, you can double-click (or use select Edit Master Shape from its right mouse menu). You will see that the Text callout master is comprised of two shapes, Sheet.5 (which is the group) and Sheet.6 (a sub-shape of the group). The Label text is part of Sheet.5, whilst the value (Abc) is part of Sheet.6.

You can now edit the font of either the whole lot by selecting the shape, or you can just do the value by selecting Sheet.6 in the Master Explorer window.

Now, you can close the Master Edit window to save the changes.

Now, when you go to the Edit Data Graphic dialog for Toplogy 1 Data Graphic, and select Edit Item for, say, Operating System, you will find your new variation, Text callout A, listed.

So, when you select your new variation of Text callout, all of the shapes that use it will be updated automatically!

Q.E.D.

By the way, there’s more like this in my book …

Linking Visio WBS Modeler Diagrams to Project

Thu, 24 Apr 2008 11:34:02 GMT

I have recently been asked if it is possible to update the % Complete data diagrams created with the WBS Modeler Visio 2007 Add-in (http://www.microsoft.com/downloads/details.aspx?FamilyID=34c28a49-e14c-4a7d-8d49-90061fe08ab4&DisplayLang=en). Well, it is always possible with custom code, but it is intended that the WBS Modeler diagrams can be refreshed using the Link Data to Shapes feature in Visio 2007 Professional. I know this because I wrote WBS Modeler, and in this article, I will tell you how.

Firstly, I will use the Commercial Construction project that is installed with the Visio SDK for this example, which I show an extract from below.

Then I created a new WBS Modeler diagram based on the above project.

I simply imported the whole project using the WBS Modeler / Import from Microsoft Office Project menu action.

The Element shapes are color coded according to their Outline Level by default, and they are labeled with their Outline Number and a truncated version of the Element Name shape data. Notice that the Shape Data window shows more of the Project data fields than is displayed on the shape.

NB If you do see all of these Shape Data rows, then click on the page and ensure that the page Hide extra Project properties is set to False in the Shape Data window.

In this particular sample project, there are no costs, nor are there any non-zero % Complete values, so I'll change some of these in the original project, then update the Visio diagram.

Therefore, I revealed the Unique ID, % Complete and Cost fields in Project.

I then exported the Project tasks to Microsoft Excel using File / SaveAs and Selected Data in the Project Export Wizard.

You then need to select the Unique ID and any other fields that you want to export.

You can optionally save the Map for future use, but you should end up with an Excel spreadsheet that contains the data that you requested.

Then, in Visio 2007 Professional, you can click Data / Link Data to Shapes and select the Excel workbook that you just created. There should be just one region, Task_Table1$, and you should ensure that the Unique_ID column is checked.

When you click Finish, the Excel data is copied into the Visio document as External Data. You must now ensure that the column labels match those on the Element shapes by opening the Column Settings dialog from the right-mouse menu of the External Data window. So, Unique_ID becomes Unique ID and Percent_Complete becomes % Complete. This will ensure that the data is copied into existing Shape Data rows rather than creating new ones.

In addition, I changed the Data Type for the Cost field to String because my original Element shape is expecting a string.

You can then choose Automatically Link from the right-mouse menu of the External Data window, and use the All shapes on this page option. Finally, you must ensure that the Data Column Unique ID equals the Shape Field Unique ID.

When the links have been created, you will probably think that something has gone wrong because everything has turned black.

However, this is normal because Visio has automatically assigned a Data Graphic to all the shapes, so all you need to do is edit it. In this example, I simply deleted the two text fields that Visio had automatically created, and then added a new Data Bars for the % Complete and Cost fields, and Color By Value for the Parent Element.

I entered the Custom Formula={% Complete}*100 so that the numbers would be between 0 and 100. You can enter these formulae by selecting More Fields at the bottom of the Data Fields drop-down list on the New Data Bar dialog.

I also edited the Label text and selected the position to be Center/Bottom Edge.

Although I set the Cost property as String for the import, Visio is still able to treat the contents as a number for the Data Graphics, so I thought a Thermometer Data Bar would be interesting. Note that I set the Maximum Value to more than the known data values. (See my Visio Conference blog for code on how to automatically update maxima and minima values).

Finally, I decided to use Color By Value on the Parent Element property rather than on the Outline Level one ... just to make the diagram more interesting.

When all of this is applied, then you will hopefully see how much more understandable the data is when Link Data to Shapes and Data Graphics are combined in Visio 2007 Professional.

So,the overall effect is a linked WBS Modeler diagram that can be refreshed whenever the data is published into the Excel workbook from Project.

Of course, any Visio diagram that utilises Data Graphics is much enhanced by a legends for the linked recordsets, Color By Value and Icon Sets. However, this is not available out-of-the-box, so you will have to trial (then hopefully buy) my own DataLegends add-in (http://www.bvisual.net/Products/DataLegends.aspx)

The files above are available for download at http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/CommercialConstruction.zip

Setting Visio Shape Cell Values By Connections

Sun, 20 Apr 2008 21:30:36 GMT

A recent newsgroup poster asked me to explain how to set the line color and weight of a connector according to the shapes it is connected to. So, in this article, I have tried to explain one method of achieving this with minimal external coding.

In this example, I have created a rectangle shape that has a single Shape Data row, MyData, which has a fixed list of values, A;B;C.

The connector shape has been modified to trigger an event whenever a connection is made or unmade. If the user successfully connects two rectangles with the same MyData value, then the line (weight and color) of the connector shape is amended to match the rectangle shapes.

The diagram below attempts to explain the relationships between the cells in the rectangle, connector and page.

The red arrows indicate the values updated by the VBA code; the green arrows indicate the values referenced from the page shapesheet, and the blue arrows indicate the values referenced within the same shapesheet.

Page

I modified the page shapesheet to have three new User-defined rows in order to have a centralised list of possible data values, and the corresponding line weights and colors for each value. This is done with a simple semi-colon separated list, which could have been updated from an external data source.

User.MyDataList="A;B;C"

User.MyLineWeights="1pt;2pt;3pt"

User.MyLineColors="RGB(255,0,0);RGB(0,255,0);RGB(0,0,255)"

In fact, these page cells could be inserted into the Master page of both the Rectangle and Connector shape (as in the sample diagram available below) and the act of dropping either master onto a new page will have the effect of duplicating these cells in the page shapesheet.

Rectangle

Then I modified a rectangle to have a new Shape Data row (Prop.MyData), where the format cell referenced the page User.MyDataList cell.

Prop.MyData.Format=ThePage!User.MyDataList

The line weight and color of the rectangle is changed with the following formulae:

LineWeight=GUARD(INDEX(LOOKUP(Prop.MyData,Prop.MyData.Format),ThePage!User.MyLineWeights))

LineColor=GUARD(INDEX(LOOKUP(Prop.MyData,Prop.MyData.Format),ThePage!User.MyLineColors))

Dynamic Connector

Now, in order to get the connector shape to fire an event whenever the connector shape is connected or disconnected, it is necessary to call a bit of code, ConnectIT, whenever the value in the BegTrigger or EndTrigger changes. These cells are automatically updated whenever a connect or disconnect is done.

User.ConnectITTrigger=DEPENDSON(BegTrigger,EndTrigger)+CALLTHIS("ConnectIT","")

User.BegIdx=0

User.EndIdx=0

I amended the LineWeight and LineColor formulae to respond to values in the User.BegIdx and User.EndIdx cells.

LineWeight=THEMEGUARD(IF(AND(User.BegIdx=User.EndIdx,User.BegIdx>0,ISERRVALUE(BeginX)=FALSE,ISERRVALUE(EndX)=FALSE),INDEX(User.BegIdx,ThePage!User.MyLineWeights),IF(CELLISTHEMED(FALSE),THEME("ConnectorWeight"),SETATREFEXPR(THEME("ConnectorWeight")))))

LineColor=THEMEGUARD(IF(AND(User.BegIdx=User.EndIdx,User.BegIdx>0,ISERRVALUE(BeginX)=FALSE,ISERRVALUE(EndX)=FALSE),INDEX(User.BegIdx,ThePage!User.MyLineColors),IF(CELLISTHEMED(FALSE),SETATREFEXPR(THEME("ConnectorColor")),SETATREFEXPR(0))))

The bold characters are those bits that I added into the existing LineWeight and LineColor formulae, in order to check that the index of the values of the rectangle shapes at either end match each other. If they do, then the line is changed too.

The ISERRVALUE(BeginX)=FALSE and ISERRVALUE(EndX)=FALSE part trap the changes due to either rectangle from being deleted.

VBA Code

Whenever the code is called, it clears the values in the User.BegIdx and User.EndIdx cells, then sets a formula to return the index of the value in the connected rectangle shapes, if they exist.

The following subroutine was added to a new module in the VBA project of the document:

Public Sub ConnectIT(ByVal shp As Visio.Shape)

If Visio.Application.IsUndoingOrRedoing Then
    Exit Sub
End If
Dim cnx As Visio.Connect
shp.Cells("User.BegIdx").Formula = "0"
shp.Cells("User.EndIdx").Formula = "0"
For Each cnx In shp.Connects
    If cnx.ToSheet.CellExists("Prop.MyData", Visio.visExistsAnywhere) Then
        If cnx.FromCell.Name = "BeginX" Then
            shp.Cells("User.BegIdx").Formula = _
                "=LOOKUP(Sheet." & cnx.ToSheet.ID & _
                "!Prop.MyData,ThePage!User.MyDataList)"
        ElseIf cnx.FromCell.Name = "EndX" Then
            shp.Cells("User.EndIdx").Formula = _
                "=LOOKUP(Sheet." & cnx.ToSheet.ID & _
                "!Prop.MyData,ThePage!User.MyDataList)"
        End If
    End If
Next

End Sub

Consequently, the connector shape responds to connections, disconnections and data changes in the connected rectangle shapes.

You can download the sample drawing here: http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/ConnectTrigger.vsd or http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/ConnectTrigger.zip

UK Counties and Boroughs Map Shapes for Visio

Fri, 04 Apr 2008 10:26:06 GMT

My friend and colleague, Chris Roth, has made lots of maps available in Visio, his latest being Germany ( http://www.visguy.com/2008/03/01/map-of-germany/ ). Well, we Brits hate being outdone by a German-American, so I have decided to make my UK Map shapes for Visio publicly available at http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/UK%20Geography%20Structure.vsd .

I created the UK map several years ago by converting from PDF to SVG to Visio, and each of the counties and boroughs have a single rectangular Master, Admin Area. I used code to replace the rectangle geometry with the actual shape geometry. This means that, although they are all different, they actually have the same Master, thus making it easier to propagate any changes, such as Shape Data rows.

The download is a multi-page document of over 3mb, so be warned, and it also includes a chart of the breakdown of the UK Administrative Areas.

The Admin Area (and County) shapes are linked to the Excel spreadsheet (http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/UK%20Counties%20and%20Unitary%20Authorities.xlsx), UK Counties and Unitary Authorities.xlsx, which contains columns of data about each area, and provides an hyperlink Notice the formula to concatenate two strings):

=HYPERLINK("http://en.wikipedia.org/wiki/" & SUBSTITUTE(C2," ","_"))

I found out that the Visio 2007 Professional LinkData to Shapes function automatically thinks that values with "xxx:" at the start are hyperlinks, so I had to uncheck the Hyperlink setting for the Information column. (Interestingly, "Code:xxxx" opens op Lutz Roeder's Reflector app on my PC!)

After making this change, I was able to Automatically Link the data to the shapes where Name = Name, and end up with a hyperlink that points to the Wikipedia for the region.

NB. I was going to use the Visio 2007 Professional Color By Value to automatically fill the regions, but I discovered that there is currently a 100 discrete value limit...so, I have used the Space Plan Color By Value legends - that does not have the limit! Maybe next version...

Enjoy!

Using Fill Patterns with DataGraphic Color By Value

Mon, 17 Mar 2008 12:20:56 GMT

Microsoft Office Visio 2007 Professional provides the ability to color shapes by different values in selected cells. This is great, but just how many color variations can your eyes detect? If you have lots of different values, then the color by value automatically produced colors can look too similar to be able to distinguish them apart. In this article, I propose a method of automatically assigning different fill patterns to similar colors so that they can be visually separated.

First, we must try to understand how the color by value works. In the following example based on a large number of uniquely named departments, I wish to be able to distinguish the spaces assigned to each one on a floor plan. I have just shown the color assignments for the first 20 departments (automatically sorted alphabetically) created with a Color By Value Data Graphic item for the Department shape data values.

Notice how the color assignments have started again from the Red for Dept 23? So, we have reached the limit of automatically assigned colors. Of course, we could decide to blend our own colors using the color picker, and there are a possible 16,777,216 different color combinations using the RGB or HSL notation, but just how many variations can the human eye perceive?

Now, the Data Graphic Color By Value formulae are added to an automatically created User.visDGCBVFill cell in the ShapeSheet of the Data Graphic master, and, therefore to all shapes that use it.

In fact, if the shape is a group, then an almost identical formula is added to the sub shapes too, except that they refer to the cell value in the group shape. Thus Prop.Department would become Sheet.5!Prop.Department (or whatever the sheet ID is).

N.B. If you intend to use Data Graphics with instances of a Master, then it is probably worthwhile making it into a group at the start, since any other Data Graphic items (Text Callouts, Data Bars and Icon Sets) will automatically convert the instances into groups.

The color of the background fill (FillBkgnd) is read from the result of User.visDGCBVFill and the foreground fill (FillForegnd) is a TINT of the back ground fill.

I should explain (or remind you if you knew this already) that the foreground and background fill colors are only both used when the fill pattern is not 1 (Solid). In fact, the presentation of foreground and background is reversed in the user interface when a fill pattern is not Solid.

This is the standard fill patterns, starting with no fill, then white (RGB(255,255,255)) solid fill foreground then applying each standard fill pattern with a blue (RGB(31, 71, 125)) pattern color. Notice how the FillForegnd and FillBkgnd cell values switch above a FillPattern of 1.

Now, the Data Graphic Color By Value uses Solid colors, therefore it is necessary to look at the reverse of the above to get a better idea of how these fill patterns would appear in a shape.

Now, not all shapes will be rectangular in appearance, so some patterns work better than others.

So, here are 40 different departments using the default color by value colors...

As you can see, it is a little difficult to distinguish some of the colors because they are exactly the same!

In the screenshot below, I have applied a VBA function, UpdateCBVFillPatterns, which has additionally cycled through a list of fill pattern numbers (in this case "13;14;15;16;17;18" ).

You can now visually distinguish different departments!

I have included the whole VBA code below for you to try. Please note that this currently expects you to select one shape that uses Color By Value before running the it, and it only updates the active page, but it could be extended to update the whole document quite easily.

In addition, I am looking into extending the legends created by our own DataLegends product (http://www.bvisual.net/Products/DataLegends.aspx ) to also show the fill patterns.

Public Sub UpdateCBVFillPatterns()
Dim shp As Visio.Shape
    If Visio.ActiveWindow.Selection.Count = 0 Then
        MsgBox "There is no shape selected!"
        Exit Sub
    Else
        Set shp = Visio.ActiveWindow.Selection.PrimaryItem
    End If
Dim mstDG As Visio.Master
    If shp.DataGraphic Is Nothing Then
        MsgBox "The selected shape does not have a data graphic!"
        Exit Sub
    Else
        Set mstDG = shp.DataGraphic
    End If
Dim gi As Visio.GraphicItem
    For Each gi In mstDG.GraphicItems
        If gi.Type = visTypeColorByValue Then
            Exit For
        End If
    Next gi
    If gi.Type <> visTypeColorByValue Then
        MsgBox "The selected shape does not have a Color by Value graphic item!"
        Exit Sub
    End If
'Enter the list of standard patterns to use
Dim patternList As String
    patternList = "13;14;15;16;17;18"

Dim bkgndColor As String
bkgndColor = "RGB(255,255,255)"
Dim mst As Visio.Master
Dim shpMst As Visio.Shape

'The Shape could have a master, so best to update it
If Not shp.Master Is Nothing Then
    Set mst = shp.Master.Open
    addTriggerCell mst.Shapes(1), patternList, bkgndColor
    'Could be applied to a sub-shape
    For Each shpMst In mst.Shapes(1).Shapes
        addTriggerCell shpMst, patternList, bkgndColor
    Next
    mst.Close
End If

Dim sel As Visio.Selection
Dim shpSel As Visio.Shape
Dim shpSub As Visio.Shape
    'Select all of the shapes in the active page that use this Data Graphic
    Set sel = Visio.ActivePage.CreateSelection(visSelTypeByDataGraphic, 0, mstDG)
    For Each shpSel In sel
        addTriggerCell shpSel, patternList, bkgndColor
        'Could be applied to a sub-shape
        For Each shpSub In shpSel.Shapes
            addTriggerCell shpSub, patternList, bkgndColor
        Next
    Next
End Sub

Private Sub addTriggerCell(ByVal shp As Visio.Shape, _
    ByVal patternList As String, ByVal bkgndColor As String)
    'Check that visDGCBVFill cell exists
    If shp.CellExists("User.visDGCBVFill", Visio.VisExistsFlags.visExistsLocally) = 0 Then
        Exit Sub
    End If
'Get the color formula
Dim clrFormula As String
    clrFormula = shp.Cells("User.visDGCBVFill").FormulaU

'Collect the matching values in order
Dim aryFormula() As String
aryFormula = Split(clrFormula, "STRSAME(")

If UBound(aryFormula) < 1 Then
Exit Sub
End If

Dim ipart As Integer
Dim aryValues() As String
    For ipart = 1 To UBound(aryFormula)
        ReDim Preserve aryValues(ipart - 1)
        aryValues(ipart - 1) = Split(aryFormula(ipart), ",")(0)
    Next ipart

'Get the cell reference
Dim cellRef As String
    cellRef = Split(aryFormula(1), ",")(1)
'Create the index of the value from the lookup list
Dim idxPart As String
    idxPart = "LOOKUP(" & cellRef & ",""" & Replace(Join(aryValues, ";"), """", "") & """)"
Dim aryPatterns() As String
    aryPatterns() = Split(patternList, ";")
'Build the trigger formula
Dim tFormula As String
    tFormula = "DEPENDSON(User.visDGCBVFill)"
    tFormula = tFormula & "+SETF(GetRef(FillPattern),INDEX(MODULUS("
    tFormula = tFormula & idxPart & "," & CStr(UBound(aryPatterns) + 1)
    tFormula = tFormula & "),""" & patternList & """))"
    tFormula = tFormula & "+IF(INDEX(MODULUS("
    tFormula = tFormula & idxPart & "," & CStr(UBound(aryPatterns) + 1)
    tFormula = tFormula & "),""" & patternList & """)"
    tFormula = tFormula & " < 2,SETF(GetRef(FillBkgnd)," & bkgndColor & "),"
    tFormula = tFormula & "SETF(GetRef(FillForegnd)," & bkgndColor & "))"
Dim irow As Integer
    If shp.CellExistsU("User.PatternTrigger", Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
        irow = shp.AddNamedRow(Visio.visSectionUser, "PatternTrigger", 0)
    Else
        shp.Cells("User.PatternTrigger").FormulaU = "="
    End If

'Apply the formula
shp.Cells("User.PatternTrigger").FormulaU = "=" & tFormula

End Sub

Visualizing Information the Smart (Diagram) Way

Wed, 06 Feb 2008 06:29:21 GMT

Those of you who are attending the Visio Conference in Redmond this week will know that I am presenting in the developer track. I am demonstrating some automation examples for building organization charts from SQL Server AdventureWorks database (slightly enhanced) in Visio 2007 Professional, without using the Org Chart Wizard.

This means that you have far more flexibility with the diagram layout, and it demonstrates Link Data to Shapes, Data Graphics and Pivot Diagrams.

The example stencil which includes all of the VBA samples used is attached to this post, along with the PowerPoint slideshow, and the SQL Server scripts to enhance the AdventureWorks database.

http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/MSVisioConference2008_DJP.vss

http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/VisioConf2008_DJP.pptx

http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/VisioConf2008DBScripts.zip

Creating PolyLines From Existing Shapes in Visio

Mon, 10 Dec 2007 17:30:46 GMT

A couple of posts in the Visio newsgroups got me thinking this weekend. One was from an Autocad conversant user who would prefer Visio to draw a continuous line between points rather than doing the normal click, hold and drag with line tool because he has tendonitis; and the other wanted to draw a circle centered on a vertex because he is drawing land boundaries.

Visio has a PolyLine line type, but, as far as I am aware, it can only be created in code - there is no menu or toolbar button to enable you to use it. It was introduced for converting CAD lines, and is simply a series of X and Y co-ordinates in a single cell, rather than the normal co-ordinate per row.

Visio has a Stamp Tool, which used to be on a toolbar out-of-the-box, but it seems to have disappeared in Office Visio 2007. Fortunately, it is simple to put it back by selecting Add or Remove Buttons / Customize from the down arrow at the end of any of the toolbars. This will open the Customize dialog, and then you can navigate to the Drawing Tools category, and scroll down to Stamp Tool. You can then click and drag it onto any toolbar, such as the Drawing toolbar in the example below.

The Stamp Tool enables you to drop a master shape instance with each click of the mouse. For example, I have selected the Sector - graphical master from the Visio Extras / Drawing Tool Shapes stencil, then I have selected the Stamp Tool and clicked seven times in the page.

To stop the Stamp Tool, simply Pointer Tool on the Standard toolbar.

I have included the CreatePolyLine VBA macro in this post, which has a boolean argument to optionally delete the existing shapes. To run the macro, simply select the first shape in the sequence that you want to trace a line between. I have assumed that you would put down a sequence of shapes, then select my macro immediately after re-selecting the first shape in the sequence. Then I selected my macro DrawPolyLineBetween to draw a line between each of the

The Sector - graphical shapes can be modified to snap to the geometry of the new polyline shape, if desired.

Alternatively, you can run the DrawReplacementPolyLine macro to create a polyline shape that automatically deletes the original shapes.

The new polyline shape has a single geometry section in the ShapeSheet, which uses the PolyLineTo row type, as follows:

In the following code, I have tested the vertex shapes to see if they are 1D or not. If they are 1D, then I have used the BeginX and BeginY co-ordinates as the vertex position, but if they are not 1D, then I have use the PinX and PinY co-ordinates. I have assumed that you are trying to create a closed shape - that is one where the line returns to where it started from.

Public Sub DrawPolyLineBetween()
CreatePolyLine False
End Sub

Public Sub DrawReplacementPolyLine()
CreatePolyLine True
End Sub

Private Sub CreatePolyLine(ByVal deleteOriginalShapes As Boolean)
'Author: David J Parker, bVisual - Dec 2007
'Usage : Draw a poly line between existing shapes
'Params: Optionally delete existing shapes
    If Visio.ActiveWindow.Selection.Count = 0 Then
        'Nothing selected
        Exit Sub
    End If
Dim pag As Visio.Page
Dim shp As Visio.Shape

Set shp = Visio.ActiveWindow.Selection.PrimaryItem
Set pag = Visio.ActivePage

    If pag.Shapes.Count = shp.Index Then
        'No subsequent shapes to loop thru'
        Exit Sub
    End If
Dim shpIndex As Integer
Dim vertexShape As Visio.Shape
Dim lineShape As Visio.Shape
Dim vertices As Integer
Dim xyArray() As Double

    For shpIndex = shp.Index To pag.Shapes.Count
        Set vertexShape = pag.Shapes(shpIndex)
        vertices = vertices + 1
        setVertices xyArray(), vertexShape, vertices
    Next shpIndex

    'Close the line
    Set vertexShape = pag.Shapes(shp.Index)
    vertices = vertices + 1
    setVertices xyArray(), vertexShape, vertices
    Set lineShape = pag.DrawPolyline(xyArray(), 0)
    If deleteOriginalShapes = True Then
        For shpIndex = pag.Shapes.Count - 1 To shp.Index Step -1
            pag.Shapes(shpIndex).Delete
        Next shpIndex
    End If
End Sub

Private Sub setVertices(ByRef xyArray() As Double, _
    ByVal vertexShape As Visio.Shape, ByVal vertices As Integer)
    ReDim Preserve xyArray((2 * vertices) - 1)
    If vertexShape.OneD = 0 Then
        xyArray((2 * vertices) - 2) = vertexShape.CellsSRC( _
            Visio.VisSectionIndices.visSectionObject, _
            Visio.VisRowIndices.visRowXFormOut, _
            Visio.visXFormPinX).ResultIU
        xyArray((2 * vertices) - 1) = vertexShape.CellsSRC( _
            Visio.VisSectionIndices.visSectionObject, _
            Visio.VisRowIndices.visRowXFormOut, _
            Visio.visXFormPinY).ResultIU
    Else
        xyArray((2 * vertices) - 2) = vertexShape.CellsSRC( _
            Visio.VisSectionIndices.visSectionObject, _
            Visio.VisRowIndices.visRowXForm1D, _
            Visio.vis1DBeginX).ResultIU
        xyArray((2 * vertices) - 1) = vertexShape.CellsSRC( _
            Visio.VisSectionIndices.visSectionObject, _
            Visio.VisRowIndices.visRowXForm1D, _
            Visio.vis1DBeginY).ResultIU
    End If
End Sub

Note to Microsoft Visio team:-

In preparation for this blog entry, I noticed that the Stamp Tool has a bug, or at least it behaves differently from normal usage. - if the page is scaled then the stamped master instances are scaled, but the same master, when dragged from the stencil, are sometimes not. Thus the two operations do not produce a shape of the same size:-

In my limited testing, this behavior is limited to more complex 1D masters.

Importing Hyperlinks into Visio Shapes

Thu, 15 Nov 2007 22:07:40 GMT

Visio shapes can have multiple hyperlinks, but it can be a chore to add them with the Insert / Hyperlinks ... command. Fortunately, Visio 2007 Professional has the Data / Link Data to Shapes ... command.

If you were to have a data source, such as an Excel spreadsheet, that contains hyperlinks (see the example below)...

... then you can import these hyperlinks onto shapes, and they will be added, not only as Shape Data, but also as hyperlinks! In the example below, I have enhanced the Data Graphics to display the Shape Data on each shape.

When you save the Visio document to a web page as VML, then the multiple hyperlinks are available on each shape!

Unfortunately, the PDF and XPS exports don't preserver the multiple hyperlinks - just the first one.

Finding a Row in a Visio DataRecordset

Sun, 11 Nov 2007 22:14:59 GMT

A recent newsgroup post asked how to find a row in a Visio DataRecordset for a given criteria. Well, I have used the IT Asset Management sample in Visio 2007 Professional to demonstrate how this can be done with a VBA function.

Of course, you may wish to improve the user interface because I limited myself to using an InputBox, and I have assumed that there is only one column defining the primary key of the DataRecordset.

The sub function, FindRow, listed below first checks whether the External Data window is open, and then gets the active DataRecordset. The code then reads the columns of the DataRecordset and prompts for a selection of the number of the column that you wish to search for a value in.

The code will abort if an incorrect number is entered, otherwise you will be asked to enter the text to find in the column. Note that you can enter a wildcard "*" character.

You will then be prompted to enter the row number of the row that you want to navigate to in the External Data window. Note that you will not be prompted to select a row if there is only one matching row.

When you enter a row number, the code gets the related row ID, and uses this to select the row in the External Data window.

Here is a listing of the VBA code to find a row by criteria:

Public Sub FindRow()
'David Parker : 11/11/2007
'To find a row with a given string in a DataRecordset
Dim findString As String
Dim colString As String
Dim drs As DataRecordset
Dim col As DataColumn
Dim win As Visio.Window
Dim rowids() As Long
Dim i As Integer
Dim msg As String
Dim rowid As Long
Dim vData As Variant
Dim primKeys() As String
Dim primKey As Integer
Dim rowString As String

    'Check the active windows to find the window
    For Each win In Visio.ActiveWindow.Windows
        'The External Data window has ID = 2044
        If win.ID = 2044 Then
            Set drs = win.SelectedDataRecordset
            Exit For
        End If
    Next win
    If drs Is Nothing Then
        MsgBox "You do not have a recordset selected!"
        Exit Sub
    End If
    'Get the primary key (single assumed)
    drs.GetPrimaryKey visKeySingle, primKeys
    msg = "Enter the number of the column to search:"
    i = 1
    For Each col In drs.DataColumns
        msg = msg & vbCrLf & CStr(i) & vbTab & col.Name
        If primKeys(0) = col.Name Then
            primKey = i
        End If
        i = i + 1
    Next col
    colString = InputBox(msg, , "1")
    If Not IsNumeric(colString) Then
        MsgBox "You must enter a number between 1 and " & drs.DataColumns.Count
        Exit Sub
    ElseIf CInt(colString) < 1 Or CInt(colString) > (drs.DataColumns.Count) Then
        MsgBox "You must enter a number between 0 and " & drs.DataColumns.Count
        Exit Sub
    End If
    findString = InputBox("Enter text to find")
    If Len(findString) = 0 Then
        Exit Sub
    End If
    rowids = drs.GetDataRowIDs(drs.DataColumns.Item(CInt(colString)) & " LIKE '" & findString & "'")

    If UBound(rowids) > 0 Then
        'Need to ask which row
        msg = "Select a row to highlight"
        msg = msg & vbCrLf & "Row" & vbTab & drs.DataColumns(primKey).Name & _
            vbTab & drs.DataColumns(CInt(colString)).Name
        For i = 0 To UBound(rowids)
            rowid = rowids(i)
            vData = drs.GetRowData(rowid)
            msg = msg & vbCrLf & CStr(i + 1) & vbTab & vData(primKey - 1) & _
                vbTab & vData(CInt(colString) - 1)
        Next i
        rowString = InputBox(msg, , "1")
    Else
        'Only one row to select
        rowid = rowids(0)
        vData = drs.GetRowData(rowid)
        rowString = "1"
    End If
    If Not IsNumeric(rowString) Then
        MsgBox "You must enter a number between 1 and " & UBound(rowids) + 1
        Exit Sub
    ElseIf CInt(rowString) < 1 Or CInt(rowString) > (UBound(rowids) + 1) Then
        MsgBox "You must enter a number between 1 and " & UBound(rowids) + 1
        Exit Sub
    End If
    'Select the row in the External Data window
    win.SelectedDataRowID = rowids(CInt(rowString) - 1)
End Sub

A Working Visio Clock

Mon, 05 Nov 2007 10:54:30 GMT

A recent newsgroup post asked about the ShapeSheet programming of lines in Visio to represent the hands of a clock. Well, it made me think, so here is my solution of a clock in Visio with just the ShapeSheet, and, for good measure, you can set it to refresh every minute!

The Clock is a group shape which contains three sub shapes, one each for the hour, minute and second hand.

The display of the second hand is optional, and this can be changed by using a custom property/shape data row or via the right mouse actions.

The display of the text is also optional, and the display format of the time is changed according to whether the second hand is displayed.

I have locked the aspect ratio of the clock (the width is always equal to the height) so that I didn't have to worry about making the hands follow an elliptical path.

The user can enter a time, in the format HH:mm or HH:mm:ss, in the Time property. Note that this is just a text data type, because if it was DATETIME then the user would be presented with a Calendar picker ... not much good for entering a time. Alternatively, the user can set Synchronize to TRUE, therefore Visio will update the Time property automatically every minute (see below).

I then inserted a User-defined cells section and created eight rows.

The first three rows Hour. Minute and Second, convert the Time property text value into a TIMEVALUE, then extract the HOUR, MINUTE or SECOND part, and finally ensure that the numbers are within the valid range by using the MODULUS function.

The 5th, 6th and 7th rows take the these part time values and convert them into the swept angle from the horizontal position (3 o'clock). Note that Visio measures angles anti-clockwise from the horizontal, but a clock hand sweeps clockwise from the vertical (12 o'clock) position.

The formula in the User.SecondAngle cell is:

=ANG360(90 deg+(360 deg-360 deg*(User.Second/60)))

However, the minute hand sweeps, not only for each minute, but increments slightly between each minute according to the number of seconds. So, the formula for the User.MinuteAngle is:

=ANG360(90 deg+(360 deg-360 deg*(User.Minute/60))-((360 deg/60)*User.Second/60))

Lastly, the hour hand sweeps for each hour, plus an increment for each minute within the hour and each second within the minute. Thus the formula for the User.HourAngle is:

=ANG360(90 deg+(360 deg-360 deg*(User.Hour/12))-((360 deg/12)*User.Minute/60)-((360 deg/360)*User.Second/360))

The User.Synchronize.Format formula is:

=FORMAT(NOW(),"HH:mm:ss")

This will result in a text value for the time Now(), which evaluates every minute, or whenever the shape is re-evaluated (this could be simply resizing or moving it).

This text value can then be Prop.Time cell, if the user has elected to synchronize with the current time. So, the formula in User.Synchronize is:

=IF(Prop.UseNow,SETF(GetRef(Prop.Time),"="""&User.Synchronize.Prompt&""""),0)

Finally, User.SecondTrigger formula turns off the display of the Secnd hand by default if the user elects to synchronize, because the Now() function only fires every minute:

=DEPENDSON(Prop.UseNow)+IF(Prop.UseNow,SETF(GetRef(Prop.ShowSecondHand),"FALSE"),0)

I have also allowed for the user to set the relative length of each hand via the Shape Data, where 1 would be the radius of the clock face and, say, 0.5 would be half of the clock face radius. The user can sub select each of the hands if a different line format is desired, but I have protected the sub-shapes from group formatting.

The visibility of the SecondHandSize row is controlled by the value in the ShowSecondHand row.

I have used Controls (the yellow diamonds) to mark the centre of the clock, position each hand and the optional text block.

The position of the end each hand has to be relative to the centre of the clock, and uses the ratio of length entered by the user.

For example, the formula in the Controls.Hour.X cell is:

=GUARD(Controls.Centre+(0.5*Prop.HourHandSize*Width)*COS(User.HourAngle))

and in Controls.Hour.Y is:

=GUARD(Controls.Centre+(0.5*Prop.HourHandSize*Height)*SIN(User.HourAngle))

Note that the Tip cell for each row shows the relevant part of the Time value.

The Actions rows simply provide an alternative method of changing the boolean (TRUE/FALSE) SHape Data/Custom Property rows.

The Miscellaneous section of the ShapeSheet provides the opportunity to control the visibility of the text block, and to set the contents of the Screen Tip (Comment).

The formula in the Comment cell is:

="Time is "&IF(Prop.ShowSecondHand,FORMAT(TIMEVALUE(Prop.Time),"HH:mm:ss"),FORMAT(TIMEVALUE(Prop.Time),"HH:mm"))

Note that I used the same formula in the Text Fields section, after first using Insert / Field .., followed by Shape Data - Time, with the Clock selected. Remember that you cannot insert Text Fields rows in the

I repositioned, and resized the text block of the clock to be just below the clock, but then I modified the Text Transform section in the ShapeSheet by setting the TextPinX and TextPinY formulae to those of the Controls.Text cells.

So, the final part of the story is how to set the position of the hands!

Well, as I said, these are three sub-shapes, and each are just a simple straight line that starts at the centre of the clock face, and ends at the relevant Control in the parent shape. For example, the 1-D Endpoints of the ShapeSheet of the MinuteHand shape was amended as follows. (Note that the parent/group shape is Sheet.4 in my case - use Format / Special to discover the ID of your shape).

Well, I hope the clock is useful, and I have provided the Visio document at http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/ClockFace.vsd