Displaying the Master and Stencil Name of Shape

A recent newsgroup question asked if it is possible to display the master name and the stencil that a shape originally came from.   Following on from my last post ( Re-opening Default Stencils ), I realised that this is possible  Here’s how (once you have created a reference to the Microsoft Scripting Runtime):

Public Sub DisplayOriginalMaster()

If Visio.ActiveWindow.Selection.Count = 0 Then
Exit Sub
End If
Dim shp As Visio.Shape
Set shp = Visio.ActiveWindow.Selection.PrimaryItem
If shp.Master Is Nothing Then
MsgBox “This shape has no master”, vbExclamation
Exit Sub
End If

Dim mst As Visio.Master
Set mst = shp.Master
Dim stenName As String
stenName = getStencilName(mst.UniqueID)
If Len(stenName) = 0 Then
MsgBox “Sorry, I can’t find the stencil this master (” & mst.Name & “) is from”, vbExclamation
Else
MsgBox “This shape is the master : ” & mst.Name & vbCrLf & “is from the stencil : ” & stenName, vbExclamation
End If

End Sub

Private Function getStencilName(ByVal mstID As String) As String

Dim srcDoc As Visio.Document
Set srcDoc = Visio.ActiveDocument
Dim tmplt As String
tmplt = srcDoc.Template
If Len(tmplt) = 0 Then
Exit Function
End If

Dim fs As FileSystemObject
Set fs = New FileSystemObject
If fs.FileExists(tmplt) = False Then
Exit Function
End If
Dim winSrc As Visio.Window
Dim stenDoc As Visio.Document
Dim aryStens() As String
Dim win As Visio.Window
Dim arySrcStens() As String
For Each win In Visio.Windows
If win.Document Is srcDoc Then
Set winSrc = win
winSrc.DockedStencils arySrcStens
Exit For
End If
Next

Dim sten As String
Dim stenName As String
Dim i As Integer
For i = 0 To UBound(arySrcStens)
stenName = stenContains(arySrcStens(i), mstID)
If Len(stenName) > 0 Then
getStencilName = stenName
Exit Function
End If
Next
Dim doc As Visio.Document
Set doc = Visio.Application.Documents.OpenEx(tmplt, Visio.visOpenCopy + Visio.visOpenHidden + Visio.visOpenDontList)

For Each win In Visio.Windows
If win.Document Is doc Then
win.DockedStencils aryStens
End If
Next
For i = 0 To UBound(aryStens)
stenName = stenContains(aryStens(i), mstID)
If Len(stenName) > 0 Then
Exit For
End If
Next
‘Close the template document
doc.Close

getStencilName = stenName
End Function

Private Function stenContains(ByVal sten As String, ByVal mstID As String) As String
Dim doc As Visio.Document
Dim mst As Visio.Master
For Each doc In Visio.Application.Documents
If doc.FullName = sten Then
For Each mst In doc.Masters
If mst.UniqueID = mstID Then
stenContains = doc.Title
Exit Function
End If
Next
End If
Next
stenContains = “”
End Function

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: