Dim ticker As Integer
Dim theshapes As Shapes
Dim counter As Integer
Dim reportback As String
Set theshapes = ActivePage.Shapes
Dim thisshape As Shape
Dim shapenames As String
Dim ReText(999999)
For Each thisshape In theshapes
ticker = ticker + 1
ReText(ticker) = thisshape.Name
Next
For t = 1 To ticker
counter = counter + 1
CurName = Application.ActivePage.Shapes(ReText(t)).Name
For x = 1 To ticker
If Application.ActivePage.Shapes(ReText(x)).Name <> Application.ActivePage.Shapes(ReText(t)).Name Then
If CurName = Application.ActivePage.Shapes(ReText(x)).Text Then
reportback = reportback & Application.ActivePage.Shapes(ReText(x)).Name & vbCrLf
ActiveWindow.Select Application.ActivePage.Shapes(ReText(x)), visSelect
NewText = InputBox(Application.ActivePage.Shapes(ReText(x)) & " has a duplicate label. What would you like to change it to? ")
Application.ActivePage.Shapes(ReText(x)).Text = NewText
End If
End If
Next x
Next t
MsgBox "The following shapes have had their text changed:" & vbCrLf & reportback
And of course, as always when running fresh code, save your document to another location using a different name. Run the code and be sure it works. This way, you do not hose your work.
Well this macro only runs on the current page. So you have to click on the page tab at the bottom of the screen that you wish to check.
Also, if it returns a message box that claims nothing was changed, then basically, there were no shapes on the page that had text that matched another shapes text.
If you do not want to get into coding, you can use Visio's reporting feature and sort by name. You will still need to review the list for duplicates, but they should be easy to spot. (or you can extract the report to Excel)
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.