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
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
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
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
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)
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
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
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
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