Visio Map of the World Update

My earlier post about the world in Visio shapes, see http://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.

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.

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.

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.

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

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.

This is a link to the WorldPopulation Visio 2013 document : WorldPopulation.vsdx

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