CHANGING SHAPE NAMES

[slevitt5]

How can I write a code that would automatically change the name of a shape only if the current shape name is already being used.

Basically something that implements this: "If shape_name is already taken on the current slide, then name the shape new_shape_name."

If you need more detail, I would be happy to share the whole macro I am working on, but this is just a segment of it.

[John Wilson]

Interesting idea! I will never understand why the Microsoft coders allowed duplicate names on the same slide in 2007 on it's dumb!

To fix it automatically will not be simple though. How good a coder are you. Ideally you will need to write an AddIn that traps the selection change event and checks for duplicate names. Is that something you are able to do?

If not it might be easier at first to go for a manual check.

Here's a start


Sub chex()
Dim col As New Collection
Dim i As Integer
Dim c As Integer
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.View.Slide
On Error GoTo err
If osld Is Nothing Then err.Raise Number:=vbObjectError + 1000, _
Source:="this module", _
Description:="looks like there is no slide selected."
If err <> 0 Then Exit Sub
For Each oshp In osld.Shapes
i = i + 1
For c = 1 To col.Count
If oshp.Name = col(c) Then
oshp.Name = "Shape " & i
End If
Next c
col.Add (oshp.Name)
Next oshp
Exit Sub
err:
MsgBox "There's an error in " & err.Source & " Error is " & err.Description
End Sub

[slevitt5]

Thanks for getting back to me, I actually got it to work using a manual method similar to yours!

[slevitt5]

Actually it turns out I haven't gotten it to work exactly as I would like to. Is there a way to limit the For Each loop too only msoLinkedOLEObjects? Basically, to check if there are any duplicate names for a specific Shape.Type?

[John Wilson]

Something like this

Sub chex()
Dim col As New Collection
Dim i As Integer
Dim c As Integer
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.View.Slide
On Error GoTo err
If osld Is Nothing Then err.Raise Number:=vbObjectError + 1000, _
Source:="this module", _
Description:="looks like there is no slide selected."
If err <> 0 Then Exit Sub
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
i = i + 1
For c = 1 To col.Count
If oshp.Name = col(c) Then
oshp.Name = "Shape " & i
End If
Next c
col.Add (oshp.Name)
End If ' linked OLE
Next oshp
Exit Sub
err:
MsgBox "There's an error in " & err.Source & " Error is " & err.Description
End Sub


Are you SURE the shapes are linkedOLEobjects though. It won't work if they are not.