Visio sitemap - how to tell if shape is dimmed?

[ryanb2010]

I'm looking to programmatically delete all dimmed shapes because visio didn't seem to do it for me or collapse them (I had to click stop on the sitemap and ended up with 3000-4500 shapes).

So.. is there a property of the shape/hyperlink/whatever that would help me figure this out?

Also, you know how you can right click on a dimmed shape and go to original? Well how does visio know that they're linked? this is the less important of the two questions.

[ryanb2010]

EDIT: This is what I've made but it does NOT do the trick.

I thought it would help, but the shape count of ungrouping a dimmed shape and a non dimmed is the same.. dunno what I saw before.


Function IsDuplicate(vsoShape As Shape) As Boolean

On Error GoTo Cleanup
Dim undoScopeID As Long

If vsoShape.Shapes.Count > 1 Then

undoScopeID = BeginUndoScope("Checking for a dimmed shape")
ActiveWindow.DeselectAll
ActiveWindow.Select vsoShape, visSelect
Application.AlertResponse = 1
vsoShape.Ungroup

Dim vsoIconShape As Shape
Set vsoIconShape = ActiveWindow.Selection(1)

If vsoIconShape.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "10" Then
IsDuplicate = True
End If

End If

Cleanup:
If Err.Number <> 0 Then
MsgBox Err.Description
End If

Application.AlertResponse = 0 'clear out the "auto-Ok" clicking

'Always rollback the undo as we never want to keep the icon and text shapes split up
Call EndUndoScope(undoScopeID, False)
End Function

[ryanb2010]

Would anyone know how to maybe get at the shape context menu item and just see if it has "&Jump to Original" enabled?

[ryanb2010]

Ok, so however many hours later ;) ;)

Option Explicit

Sub RemoveAllDuplicateSiteMapShapes()

Dim vsoShape As Visio.Shape
Dim count As Integer
Dim countOfNonConnectorShapes As Integer
Dim countOfDuplicates As Integer
Dim previousShape As Shape
Dim deletePreviousShape As Boolean
Dim vsoShapesToRemove As New Collection

'MsgBox IsDuplicate() 'use this line if you just have one shape highlighted and want to check that first.
'Application.ShowChanges = False 'Can't turn this off or SelectShape will always fail

For Each vsoShape In ActiveWindow.Page.Shapes
count = count + 1

If Not vsoShape.Name Like "Dynamic connector*" Then
countOfNonConnectorShapes = countOfNonConnectorShapes + 1
If IsDuplicate(vsoShape) Then
countOfDuplicates = countOfDuplicates + 1
Debug.Print countOfDuplicates
'SelectShape vsoShape, False ' set this to true if you want to see the changes in action
vsoShapesToRemove.Add vsoShape, CStr(vsoShape.ID)
End If
End If

Next

Debug.Print "Total shapes: " & count
Debug.Print "Total non connector shapes: " & countOfNonConnectorShapes
Debug.Print "Remaining Shapes: " & countOfNonConnectorShapes - countOfDuplicates
Debug.Print "Dupe shapes to remove: " & vsoShapesToRemove.count

While vsoShapesToRemove.count > 0
Set vsoShape = vsoShapesToRemove.Item(1)
vsoShape.Delete

If (vsoShape.ID = 0) Then
vsoShapesToRemove.Remove (1)
End If
'Debug.Print vsoShapesToRemove.count
Wend

End Sub

Sub SelectShape(shp As Visio.Shape, Optional moveToShape As Boolean = True)

ActiveWindow.DeselectAll
ActiveWindow.Select shp, visSelect

If moveToShape Then
Call Application.ActiveWindow.SetViewRect(shp.Cells("pinx").Result("inches") - 1, _
shp.Cells("piny").Result("inches") + 1, 4, 4)
End If
End Sub


Function IsDuplicate(vsoShape As Shape) As Boolean

Const DUPLICATE_SETTING As Integer = 5

If vsoShape.Shapes.count >= 1 Then 'make sure there are shapes inside (this will help quickly eliminate connectors)

If vsoShape.CellsSRC(visSectionUser, visRowUser + DUPLICATE_SETTING, visUserValue).Formula = "1" Then
IsDuplicate = True
End If

End If

End Function

Function IsSelectionDuplicate() As Boolean
IsSelectionDuplicate = IsDuplicate(ActiveWindow.Selection(1))
End Function

From what I've learned, ShapeSheets hold additional information about the shape. Buried in the settings, I found that there's a key to see if one of the items in the Action menu is disabled. Well, this wasn't good enough because in that key, there was a formula using User.keyName, so I needed to get at the value of that key name and that's what I did above. It's so interesting to realize that you can have so much programming right inside a custom-made shape!!

edit: updated the logic in IsDuplicate to use a shape object - not go based on selection. I was running the code multiple times and shapes weren't getting deleted.
2nd edit: Fixin the issue "For some reason you do have to run this multiple times if you have thousands of shapes" by putting a collection and not removing from the collection unless shape.ID = 0

[ryanb2010]

Here are some good visio ShapeSheet references - coming up in the next post

[ryanb2010]

Here are some good visio ShapeSheet references.
Shapesheet Indicies (http://msdn.microsoft.com/en-us/library/aa217841(office.10).aspx) - if you need to dig into already made shapesheet settings with VBA
or if you're coding, use it and these too:

Office XP-2007 (http://msdn.microsoft.com/en-us/library/aa200960(office.10).aspx)
2010 (http://www.packtpub.com/article/understanding-shapesheet-microsoft-visio-2010)

And wow - I JUST realized that you can view the ShapeSheet window on a shape you didn't make. Just highlight the shape on your diagram and go to Window > Show ShapeSheet. You seem to need to repeat this if you want to check a different shape.