Visio Map of the World Update

My earlier post about the world in Visio shapes, see https://blog.bvisual.net/2013/08/16/visio-map-of-the-world/ , has been one of my most popular, and a reader recently asked about changing the colour of countries by data not in my original worksheet, and another asked about adding labelled dots.

Well, at first, I thought it would be quite simple to add more Data Graphics with the Color By Value that I already had, but then I realised that I needed to adjust some of the shapes that I had created from SVG in my previous article.

The problem is that some of the country shapes which were converted from SVG have geometry at the top group level. This means that any Data Graphic items, other than Color By Value, are actually sub-shapes of the group and will be hidden by the country shape itself. That is probably why the Data Graphics task, on the selected Afghanistan shape below, sent the AF label over to the right of it, whereas all the group shapes with all their geometry in sub-shapes, such as the AE (United Arab Emirates) shape, placed the label in its centre.

image

Therefore, I wrote some VBA code to move the geometry out of the top-level group shape into a new sub-shape, which then allowed the Data Graphic task to position the graphic items over the group shape. Notice that the af shape in the Drawing Explorer below now has a subshape, also called af.

image

I have listed the code below, and it can be run against the earlier version of the world map that I posted.

Public Sub FixSVGGroups()
Dim shpGroup As Visio.Shape
Dim shpNew As Visio.Shape
Dim iSect As Integer
Dim iRow As Integer
Dim iCell As Integer
Dim iNewSect As Integer
Dim iNewRow As Integer
Dim iNewCell As Integer
Dim lastSect As Integer
'Check all shapes on the page
For Each shpGroup In Visio.ActivePage.Shapes
    If shpGroup.Type = Visio.VisShapeTypes.visTypeGroup Then
        'Ensure that it is a valid country shape
        If shpGroup.CellExists("Prop._VisDM_ID", _
            Visio.VisExistsFlags.visExistsAnywhere) _
            And shpGroup.SectionExists(Visio.visSectionFirstComponent, _
                Visio.VisExistsFlags.visExistsAnywhere) Then
            'Need to move the geometry sections to a sub-shape
            'Draw a rectangle (easiest shape)
            Set shpNew = shpGroup.DrawRectangle( _
                0, 0, _
                shpGroup.Cells("Width").ResultIU, _
                shpGroup.Cells("Height").ResultIU)

            'Remove the dummy rectangle
            shpNew.DeleteSection Visio.visSectionFirstComponent
            For iSect = Visio.visSectionFirstComponent To _
                Visio.visSectionLastComponent
                If shpGroup.SectionExists(iSect, _
                    Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
                    lastSect = iSect - 1
                    Exit For
                End If
                shpNew.AddSection iSect
                For iRow = 0 To shpGroup.RowCount(iSect) - 1
                    shpNew.AddRow iSect, iRow, shpGroup.RowType(iSect, iRow)
                    For iCell = 0 To shpGroup.RowsCellCount(iSect, iRow) - 1
                        shpNew.CellsSRC(iSect, iRow, iCell).FormulaU = _
                            shpGroup.CellsSRC(iSect, iRow, iCell).FormulaU
                    Next iCell
                Next iRow
            Next iSect
            
            iSect = Visio.visSectionObject
            iRow = Visio.VisRowIndices.visRowFill
            
            For iCell = 0 To shpNew.RowsCellCount(iSect, iRow) - 1
                shpNew.CellsSRC(iSect, iRow, iCell).FormulaU = _
                    "=" & shpGroup.NameID & "!" & _
                        shpNew.CellsSRC(iSect, iRow, iCell).Name
            Next iCell
            
            iRow = Visio.VisRowIndices.visRowLine
            For iCell = 0 To shpNew.RowsCellCount(iSect, iRow) - 1
                shpNew.CellsSRC(iSect, iRow, iCell).FormulaU = _
                    "=" & shpGroup.NameID & "!" & _
                        shpNew.CellsSRC(iSect, iRow, iCell).Name
            Next iCell
            
            'Delete geometry sections from the group
            For iSect = lastSect To Visio.visSectionFirstComponent Step -1
                shpGroup.DeleteSection iSect
            Next
            
            shpGroup.UpdateAlignmentBox
            
            If shpGroup.CellExists("Controls.msvDGPosition.X", _
                    Visio.visExistsAnywhere) Then
                shpGroup.Cells("Controls.msvDGPosition.X").Formula = _
                    shpGroup.Cells("Width").ResultIU * 0.5
                shpGroup.Cells("Controls.msvDGPosition.Y").Formula = _
                    shpGroup.Cells("Height").ResultIU * 0.5
            End If
            shpNew.Name = shpGroup.Name
            
        End If
    End If
Next
End Sub

 

So, now that I have a map that can utilise more than just Color By Value Data Graphics, I added extra columns of data from a second worksheet to the existing country Shape Data from my earlier post.

image

 

One of these extra columns contains the estimated population, so I changed the Data Graphics to display the population as Color By Value, and the ISO2 code as a Circle callout, with a Value Length = 2.

image

This results in a rather nice world display of population size per country.

image

 

To complete the map, I added a legend using the DATA ribbon button, but was not thrilled with the default appearance, so I edited it, just by selecting the elements and overtyping.

image image
Default Legend Edited Legend

 

This is a link to the WorldPopulation Visio 2013 document : http://sdrv.ms/1hA3G2V

I have updated the original BlankWorld.vsdx file in the first article.

3 Responses to “Visio Map of the World Update”

  1. Fredrik Öhgren Says:

    Hi David,

    Thank you for your blog. This is exactly what i was looking for. I’m working in Visio 2010 and I wonder if it is possible to extract the “External Data” from the vsd-file to an Excel-file and re-link it. How can I else edit/add data?

    best regards,
    Fredrik Öhgren

  2. Sadettin Says:

    Hey David,

    I just wanted to thank you. This helped me a lot during my master’s thesis 🙂

    Kind regards

    Sadettin


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

davecra.wordpress.com/

Microsoft Office Development, and more...

PowerShell.Amsterdam

Automate, Accelerate, Accurate

johnvisiomvp

Life with Visio and other Microsoft Toys!

Title (Required)

Windows Server Essentials Tips & Tricks

Nilsandrey's Weblog

Just another WordPress.com weblog

Things that Should be Easy

Every so often (too often in the IT industry) I encounter things that should have been very easy to do but turned out to be far too complicated. My favorite topics include SharePoint, .Net development, and software architecture, especially distributed systems.

Visio Guy

Shapes, Stencils, Drawings Templates, Tutorials, Tips & Developer Info for Microsoft Visio

Hannes's Virtual Earth

Tips & Tricks around Mapping and Cloud Computing

Pluralsight blog

be smart, be clear, be visual ...

%d bloggers like this: