P
pt
Visio seems to lack the ability to do a search/replace on shapes.
Working with some code posted by David Parker, I have hacked a little
diddy that seems to do the trick.
Usage: Place one of the "replacement" shapes on your drawing, then
using the SHIFT, select all the shapes to be replaced and run the
macro. It will (as did Divid's original) replace the current shape(s)
with the new shape, and re-do all the connections, position, and size.
It seems to work for me when replacing a bunch of "Predefined
process" shapes with "Process" shapes.
Be careful of Google/newsreaders wrapping some longer lines!!!
---- cut here -----
' This code originally by David Parker
' http://groups.google.com/groups?selm=#[email protected]
' I'm too lazy to repeat the steps necessary for changing a whole
bunch of shapes,
' so I've hacked it up a bit and created a "Multiple" version.
'Purpose : Enable Simple Swapping of Similar Shapes
'Usage : Drop the desired new shape near the old shapes,
' then select the new shape and then one or more old shapes (in that
order),
' then run this code
'
Public Sub SwapShapesMultiple()
Dim shpNew As Visio.Shape
' Dim i As Integer
If Visio.ActiveWindow.Selection.Count < 2 Then
'Abort if there are not 2 shapes selected
MsgBox "You must select at least 2 shapes. First select the
New shape, then one or more Old shapes to be replaced by the new
shape", vbOKOnly, "Select at least 2 shapes"
Exit Sub
Else
' New shape is first item selected.
Set shpNew = Visio.ActiveWindow.Selection.Item(1)
'Abort if shape is 1-dimensional (connector line)
If shpNew.OneD Then
MsgBox "New shape (first items selected) is a connector
line", vbOKOnly, "New shape is a connector"
Exit Sub
End If
' Save a copy of the current "New" object.
' The first time we do a "swap", we'll use the original "New"
shape.
' For any of the [optional] remaining swaps, we do a "Paste"
and make
' that the "New" object.
shpNew.Copy
End If
' Cache away references to old shapes.
Dim shpOldShapes() As Visio.Shape
ReDim shpOldShapes(Visio.ActiveWindow.Selection.Count - 2) As
Shape
For shpIdx = 2 To Visio.ActiveWindow.Selection.Count
Set shpOldShapes(shpIdx - 2) =
Visio.ActiveWindow.Selection.Item(shpIdx)
Next shpIdx
' Try deselecting? Is it necessary before paste???
Visio.ActiveWindow.DeselectAll
' Need to disable auto-layout/reroute while moving shapes to
prevent the
' layout engine from moving shapes we don't want moved (to avoid
collisions).
Dim bAutoLayout As Boolean
bAutoLayout = Application.AutoLayout
Application.AutoLayout = False
For shpIdx = LBound(shpOldShapes) To UBound(shpOldShapes)
Dim shpOld As Visio.Shape
Set shpOld = shpOldShapes(shpIdx)
' Debug.Print "Old shape #", shpIdx, " == ", shpOld.Text
'Abort if shape is 1-dimensional (connector line)
If shpOld.OneD Then
' Restore auto routing!
Application.AutoLayout = bAutoLayout
MsgBox "Old shape # " & shpIdx & " (second through last
items selected) is a connector line", vbOKOnly, "Shape is a connector"
Exit Sub
End If
' Restore the original "New" shape from the clipboard.
' It becomes the one and only active selection.
If shpIdx > 0 Then
Visio.ActiveWindow.Paste
Set shpNew = Visio.ActiveWindow.Selection.Item(1)
End If
'Change connections to new shape
Dim cnx As Visio.Connect
For Each cnx In shpOld.FromConnects
cnx.FromCell.GlueTo shpNew.CellsSRC(cnx.ToCell.Section,
cnx.ToCell.Row, cnx.ToCell.Column)
Next cnx
'Set the text
shpNew.Text = shpOld.Text
'Set the position of the new shape
shpNew.Cells("PinX").Formula = shpOld.Cells("PinX").Formula
shpNew.Cells("PinY").Formula = shpOld.Cells("PinY").Formula
'Set the size of the new shape
shpNew.Cells("Width").Formula = shpOld.Cells("Width").Formula
shpNew.Cells("Height").Formula =
shpOld.Cells("Height").Formula
'Delete the old shape
shpOld.Delete
Next shpIdx
' Restore auto routing
Application.AutoLayout = bAutoLayout
End Sub
---- cut here -----
Working with some code posted by David Parker, I have hacked a little
diddy that seems to do the trick.
Usage: Place one of the "replacement" shapes on your drawing, then
using the SHIFT, select all the shapes to be replaced and run the
macro. It will (as did Divid's original) replace the current shape(s)
with the new shape, and re-do all the connections, position, and size.
It seems to work for me when replacing a bunch of "Predefined
process" shapes with "Process" shapes.
Be careful of Google/newsreaders wrapping some longer lines!!!
---- cut here -----
' This code originally by David Parker
' http://groups.google.com/groups?selm=#[email protected]
' I'm too lazy to repeat the steps necessary for changing a whole
bunch of shapes,
' so I've hacked it up a bit and created a "Multiple" version.
'Purpose : Enable Simple Swapping of Similar Shapes
'Usage : Drop the desired new shape near the old shapes,
' then select the new shape and then one or more old shapes (in that
order),
' then run this code
'
Public Sub SwapShapesMultiple()
Dim shpNew As Visio.Shape
' Dim i As Integer
If Visio.ActiveWindow.Selection.Count < 2 Then
'Abort if there are not 2 shapes selected
MsgBox "You must select at least 2 shapes. First select the
New shape, then one or more Old shapes to be replaced by the new
shape", vbOKOnly, "Select at least 2 shapes"
Exit Sub
Else
' New shape is first item selected.
Set shpNew = Visio.ActiveWindow.Selection.Item(1)
'Abort if shape is 1-dimensional (connector line)
If shpNew.OneD Then
MsgBox "New shape (first items selected) is a connector
line", vbOKOnly, "New shape is a connector"
Exit Sub
End If
' Save a copy of the current "New" object.
' The first time we do a "swap", we'll use the original "New"
shape.
' For any of the [optional] remaining swaps, we do a "Paste"
and make
' that the "New" object.
shpNew.Copy
End If
' Cache away references to old shapes.
Dim shpOldShapes() As Visio.Shape
ReDim shpOldShapes(Visio.ActiveWindow.Selection.Count - 2) As
Shape
For shpIdx = 2 To Visio.ActiveWindow.Selection.Count
Set shpOldShapes(shpIdx - 2) =
Visio.ActiveWindow.Selection.Item(shpIdx)
Next shpIdx
' Try deselecting? Is it necessary before paste???
Visio.ActiveWindow.DeselectAll
' Need to disable auto-layout/reroute while moving shapes to
prevent the
' layout engine from moving shapes we don't want moved (to avoid
collisions).
Dim bAutoLayout As Boolean
bAutoLayout = Application.AutoLayout
Application.AutoLayout = False
For shpIdx = LBound(shpOldShapes) To UBound(shpOldShapes)
Dim shpOld As Visio.Shape
Set shpOld = shpOldShapes(shpIdx)
' Debug.Print "Old shape #", shpIdx, " == ", shpOld.Text
'Abort if shape is 1-dimensional (connector line)
If shpOld.OneD Then
' Restore auto routing!
Application.AutoLayout = bAutoLayout
MsgBox "Old shape # " & shpIdx & " (second through last
items selected) is a connector line", vbOKOnly, "Shape is a connector"
Exit Sub
End If
' Restore the original "New" shape from the clipboard.
' It becomes the one and only active selection.
If shpIdx > 0 Then
Visio.ActiveWindow.Paste
Set shpNew = Visio.ActiveWindow.Selection.Item(1)
End If
'Change connections to new shape
Dim cnx As Visio.Connect
For Each cnx In shpOld.FromConnects
cnx.FromCell.GlueTo shpNew.CellsSRC(cnx.ToCell.Section,
cnx.ToCell.Row, cnx.ToCell.Column)
Next cnx
'Set the text
shpNew.Text = shpOld.Text
'Set the position of the new shape
shpNew.Cells("PinX").Formula = shpOld.Cells("PinX").Formula
shpNew.Cells("PinY").Formula = shpOld.Cells("PinY").Formula
'Set the size of the new shape
shpNew.Cells("Width").Formula = shpOld.Cells("Width").Formula
shpNew.Cells("Height").Formula =
shpOld.Cells("Height").Formula
'Delete the old shape
shpOld.Delete
Next shpIdx
' Restore auto routing
Application.AutoLayout = bAutoLayout
End Sub
---- cut here -----