Filter Visio External Data to Drop Shapes

I have recently been demonstrating how to automatically drop data point shapes into the correct latitude \ longitude position over a map image in Visio, and in this instalment I show how to automatically filter the dropped data points by a rectangular area. This will only work after calibrating the map image as in my previous article and then using the Data Point shape (or similar) from

The principles of reading the Shape Data value from a selected shape to automatically drop rows from the active External Data window using the selected master shape could be applied to many scenarios.


The Open Bing Maps hyperlink that I added will also create a rectangle in the Bing Maps window:


The Area Marker master is just a simple rectangle with four Shape Data rows, and some optional inserted text:


The important formula is in the User.LLPositionTrigger row that I added. This updates the four Shape Data rows from the page User-defined cells that I added in the previous article .


User.LLPositionTrigger =DEPENDSON(PinX,PinY,Width,Height)+SETF(GetRef(Prop.LongitudeLeft),ThePage!User.LLPosition1Lon+(((PinX-LocPinX-ThePage!User.LLPosition1X)/(ThePage!User.LLPosition1X-ThePage!User.LLPosition2X))*(ThePage!User.LLPosition1Lon-ThePage!User.LLPosition2Lon)))+SETF(GetRef(Prop.LatitudeTop),ThePage!User.LLPosition1Lat+(((PinY+Height-LocPinY-ThePage!User.LLPosition1Y)/(ThePage!User.LLPosition1Y-ThePage!User.LLPosition2Y))*(ThePage!User.LLPosition1Lat-ThePage!User.LLPosition2Lat)))+SETF(GetRef(Prop.LongitudeRight),ThePage!User.LLPosition1Lon+(((PinX+Width-LocPinX-ThePage!User.LLPosition1X)/(ThePage!User.LLPosition1X-ThePage!User.LLPosition2X))*(ThePage!User.LLPosition1Lon-ThePage!User.LLPosition2Lon)))+SETF(GetRef(Prop.LatitudeBottom),ThePage!User.LLPosition1Lat+(((PinY-LocPinY-ThePage!User.LLPosition1Y)/(ThePage!User.LLPosition1Y-ThePage!User.LLPosition2Y))*(ThePage!User.LLPosition1Lat-ThePage!User.LLPosition2Lat)))
Hyperlink.BingMaps.Address =""
Hyperlink.BingMaps.ExtraInfo ="v=2&sty=r&sp=polyline."&Prop.LatitudeBottom&"_"&Prop.LongitudeLeft&"_"&
Actions.AddMarker.Action =CALLTHIS("AddMarkers","")
Actions.HideText.Action =SETF(GetRef(HideText),NOT(HideText))
Actions.HideText.Checked =HideText

NB Some line-breaks were added in the formulas above but must be removed when pasting into ShapeSheet cells.

I inserted four lines of text in the shape:


For clarity, the formulas are:

=Prop.LongitudeLeft.Label&" = "&FORMAT(Prop.LongitudeLeft,"#.0000")
=Prop.LongitudeRight.Label&" = "&FORMAT(Prop.LongitudeRight,"#.0000")
=Prop.LatitudeTop.Label&" = "&FORMAT(Prop.LatitudeTop,"#.0000")
=Prop.LatitudeBottom.Label&" = "&FORMAT(Prop.LatitudeBottom,"#.0000")


This is the sub-function called by the right mouse action of the Area Marker shape:

Public Sub AddMarkers(ByVal shp As Visio.Shape)
‘Called by right mouse action on Area Marker shape
    Call AddFilteredLL
End Sub

This function does most of the work!

Public Sub AddFilteredLL()
On Error GoTo errHandler

Dim mst As Visio.Master
Dim shp As Visio.Shape
Dim iRow As Integer
Dim hasLatitude As Boolean
Dim hasLongitude As Boolean

‘Get the select data point shape
    Set mst = GetSelectedMaster()
    If mst Is Nothing Then
        MsgBox "You must select a master to drop first", vbExclamation
        Exit Sub
        ‘Check that shape contains Latitude and Longitude shape data
        Set shp = mst.Shapes(1)
        For iRow = 0 To shp.RowCount(visSectionProp) – 1
            If shp.CellsSRC(visSectionProp, iRow, _
                    visCustPropsLabel).ResultStr("") = "Latitude" Then
                hasLatitude = True
            ElseIf shp.CellsSRC(visSectionProp, iRow, _
                    visCustPropsLabel).ResultStr("") = "Longitude" Then
                hasLongitude = True
            End If
    End If

    If hasLatitude = False Or hasLongitude = False Then
        MsgBox "The selected master does not have Latitude and Longitude Shape Data", vbExclamation
        Exit Sub
    End If
    If ActiveWindow.Selection.Count = 0 Then
        MsgBox "You must select a Area Marker shape first", vbExclamation
        Exit Sub
    End If
‘Get the selected shape in the page
    Set shp = ActiveWindow.Selection.PrimaryItem

‘Get the Lat \ Lon of each edge
Dim latBottom As Double
Dim latTop As Double
Dim lonLeft As Double
Dim lonRight As Double

    If shp.CellExists("Prop.LatitudeBottom", Visio.visExistsAnywhere) <> 0 Then
        latBottom = shp.Cells("Prop.LatitudeBottom").ResultIU
    End If
    If shp.CellExists("Prop.LatitudeTop", Visio.visExistsAnywhere) <> 0 Then
        latTop = shp.Cells("Prop.LatitudeTop").ResultIU
    End If
    If shp.CellExists("Prop.LongitudeLeft", Visio.visExistsAnywhere) <> 0 Then
        lonLeft = shp.Cells("Prop.LongitudeLeft").ResultIU
    End If
    If shp.CellExists("Prop.LongitudeRight", Visio.visExistsAnywhere) <> 0 Then
        lonRight = shp.Cells("Prop.LongitudeRight").ResultIU
    End If
    If latBottom = 0 Or latTop = 0 Or lonLeft = 0 Or lonRight = 0 Then
        MsgBox "You must select a Area Marker shape first", vbExclamation
        Exit Sub
    End If
‘Get the datarecordset
Dim drs As DataRecordset
Dim drsExists As Boolean

    If Visio.ActiveDocument.DataRecordsets.Count = 0 Then
        Exit Sub
    End If
    Set drs = Visio.ActiveWindow.Windows.ItemFromID( _

    If drs Is Nothing Then
        ‘Abort if not present
        MsgBox "There is no active external data!", vbInformation
        Exit Sub
    End If

‘Get the Latitude column number
Dim latColumn As Long
    latColumn = getColumnIndexByName(drs, "Latitude")
    If latColumn = -1 Then
        ‘Abort if not present
        MsgBox "There is no Latitude in this recordset!", vbInformation
        Exit Sub
    End If
‘Get the Longitude column number
Dim lonColumn As Long
    lonColumn = getColumnIndexByName(drs, "Longitude")
    If lonColumn = -1 Then
        ‘Abort if not present
        MsgBox "There is no Longitude in this recordset!", vbInformation
        Exit Sub
    End If
Dim sel As Visio.Selection
Dim pag As Visio.Page
    Set pag = ActivePage
    Set sel = pag.CreateSelection(visSelTypeByMaster, 0, mst)
Dim aryRowIDs() As Long
Dim criteria As String

    criteria = "[Longitude] >= " & lonLeft & " AND [Longitude] <= " & lonRight & _
        " AND [Latitude] >= " & latBottom & " AND [Latitude] <= " & latTop
    aryRowIDs = drs.GetDataRowIDs(criteria)

    ‘Iterate thru the datarecordset rows
    For iRow = 0 To UBound(aryRowIDs)
        Set shp = pag.DropLinked(mst, 0, 0,, aryRowIDs(iRow), False)
    Next iRow
    Exit Sub
    MsgBox Err.Description
    Resume exitHere
End Sub

The following code returns the selected master shape in the active stencil, or nothing if there is not one selected.

Private Function GetSelectedMaster() As Visio.Master
‘Called by AddFilteredLL
Dim vsoWindow As Visio.Window
Dim aobjSelectedMasters() As Object
Dim intNumberMasters As Integer
Dim vsoMaster As Visio.Master
Dim intCounter As Integer
    intNumberMasters = 0
    Set vsoMaster = Nothing
    For Each vsoWindow In ActiveWindow.Windows
        If (vsoWindow.Type = VisWinTypes.visStencil Or _
                vsoWindow.Type = visDockedStencilBuiltIn) Then
            aobjSelectedMasters = vsoWindow.SelectedMasters
            For intCounter = LBound(aobjSelectedMasters) To UBound(aobjSelectedMasters)
                On Error Resume Next
                Set vsoMaster = Nothing
                Set vsoMaster = aobjSelectedMasters(intCounter)
                If Not vsoMaster Is Nothing Then
                    intNumberMasters = intNumberMasters + 1
                    Exit For
                End If
            If (intNumberMasters > 0) Then
                Exit For
            End If
        End If
    Set GetSelectedMaster = vsoMaster
End Function

This function gets the index of a data recordset column by name

Private Function getColumnIndexByName(ByVal drs As DataRecordset, _
    ByVal columnName As String) As Integer
‘Purpose: Return the named column index (or -1 if not present)
‘Author : David J Parker, bVisual, 2015, no rights reserved

Dim column As Integer
    getColumnIndexByName = -1
    For column = 1 To drs.DataColumns.Count
        If drs.DataColumns.Item(column).Name = columnName Then
            getColumnIndexByName = column
            Exit For
        End If
    Next column
End Function

Visio 2013 :


Leave a Reply

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

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

Google photo

You are commenting using your Google 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 )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.


O365 and SharePoint

Simplify Tasks

Want to learn the simple way?

Paul Turley's SQL Server BI Blog

sharing my experiences with the Microsoft data platform, SQL Server BI, Data Modeling, SSAS Design, Power Pivot, Power BI, SSRS Advanced Design, Power BI, Dashboards & Visualization since 2009

John Goldsmith's visLog

be smart, be clear, be visual ...

Mo's blog

Personal views on Dynamics 365 for Operations and Technical Architecture.

Chris Webb's BI Blog

Microsoft Power BI, Analysis Services, MDX, DAX, M, Power Pivot and Power Query

Azure Solutions for Office 365, and more...

Rob Fahrni



Life with Visio and other Microsoft Toys!

Nilsandrey's Weblog

Just another 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

Smart graphics for visual people

%d bloggers like this: