Drawing Objects with duplicate names problem
 

Hi all,

Drawing Objects can have duplicate names, if renamed by user or if copied.
Mention has been made of this anomaly in this ng but I haven't seen a
solution to my problem.

My sheet can have 100's of objects, possibly some copied. If user selects a
large number, I want to split these into smaller, referenced multiple
objects. My problem is how to do this and ensure I reference each correctly.

Following demonstrates:

Sub DupShapeNames()
Dim i As Long
Dim lft As Single, tp As Single
Dim wd As Single, ht As Single
Dim obj As Object
Dim ws As Worksheet
Set ws = ActiveSheet

ws.DrawingObjects.Delete 'delete all objects
With [b2]
lft = .Left: tp = .RowHeight
wd = .Width * 1.5: ht = tp * 1.5
End With

With ws.Shapes
For i = 1 To 4
With .AddShape(1, lft, tp, wd, ht)
.Name = "Rect_" & i
.TextFrame.Characters.Text = .Name
End With
tp = tp + ht * 2
Next
End With

ActiveSheet.DrawingObjects(Array(2, 3, 4)).Copy
[f5].Select
ActiveSheet.Paste 'these have duplicate names
[a1].Select

''simulate user selection or more than two
''objects with duplicate names
ws.DrawingObjects(Array(5, 6, 7)).Select

'Stop ''look at selection

'' want to reference [say] the first two selected objects
Set obj = Selection
Dim v(1 To 2)
For i = 1 To UBound(v)
v(i) = obj(i).Name
Next

Set obj = ws.DrawingObjects(v)
obj.Select
''## The problem - objects 2 & 3 are ref'd, not 5 & 6

''''''''''''
'' Duplicate names also appear to have same index
'' shame! if unique problem is easily solved
i = 0
For Each obj In ws.DrawingObjects
i = i + 1
Debug.Print i; obj.Name, obj.Index
Next

End Sub

Also, need to cater for any type or mixture of selected types, not just
rectangles.

TIA,
Peter T

Drawing Objects with duplicate names problem
 

'' want to reference [say] the first two selected objects
Set obj = Selection
Dim v(1 To 2)
For i = 1 To UBound(v)
v(i) = obj(i).ShapeRange.ZOrderPosition
Next

Set obj = ws.Shapes.Range(v)
obj.Select

selects the correct boxes.

--
Regards,
Tom Ogilvy


"Peter T" <peter_t@discussions wrote in message
...
Hi all,

Drawing Objects can have duplicate names, if renamed by user or if copied.
Mention has been made of this anomaly in this ng but I haven't seen a
solution to my problem.

My sheet can have 100's of objects, possibly some copied. If user selects
a
large number, I want to split these into smaller, referenced multiple
objects. My problem is how to do this and ensure I reference each
correctly.

Following demonstrates:

Sub DupShapeNames()
Dim i As Long
Dim lft As Single, tp As Single
Dim wd As Single, ht As Single
Dim obj As Object
Dim ws As Worksheet
Set ws = ActiveSheet

ws.DrawingObjects.Delete 'delete all objects
With [b2]
lft = .Left: tp = .RowHeight
wd = .Width * 1.5: ht = tp * 1.5
End With

With ws.Shapes
For i = 1 To 4
With .AddShape(1, lft, tp, wd, ht)
.Name = "Rect_" & i
.TextFrame.Characters.Text = .Name
End With
tp = tp + ht * 2
Next
End With

ActiveSheet.DrawingObjects(Array(2, 3, 4)).Copy
[f5].Select
ActiveSheet.Paste 'these have duplicate names
[a1].Select

''simulate user selection or more than two
''objects with duplicate names
ws.DrawingObjects(Array(5, 6, 7)).Select

'Stop ''look at selection

'' want to reference [say] the first two selected objects
Set obj = Selection
Dim v(1 To 2)
For i = 1 To UBound(v)
v(i) = obj(i).Name
Next

Set obj = ws.DrawingObjects(v)
obj.Select
''## The problem - objects 2 & 3 are ref'd, not 5 & 6

''''''''''''
'' Duplicate names also appear to have same index
'' shame! if unique problem is easily solved
i = 0
For Each obj In ws.DrawingObjects
i = i + 1
Debug.Print i; obj.Name, obj.Index
Next

End Sub

Also, need to cater for any type or mixture of selected types, not just
rectangles.

TIA,
Peter T

Drawing Objects with duplicate names problem
 

That's great !

My first reaction when I saw your suggestion is what happens if user has
changed ZOrder's. But that's not a problem.

Set obj = ws.Shapes.Range(v)
and
Set obj = ws.DrawingObjects(v)
both work

Thanks Tom,

Regards,
Peter T

"Tom Ogilvy" wrote in message
...
'' want to reference [say] the first two selected objects
Set obj = Selection
Dim v(1 To 2)
For i = 1 To UBound(v)
v(i) = obj(i).ShapeRange.ZOrderPosition
Next

Set obj = ws.Shapes.Range(v)
obj.Select

selects the correct boxes.

--
Regards,
Tom Ogilvy


"Peter T" <peter_t@discussions wrote in message
...
Hi all,

Drawing Objects can have duplicate names, if renamed by user or if
copied.
Mention has been made of this anomaly in this ng but I haven't seen a
solution to my problem.

My sheet can have 100's of objects, possibly some copied. If user
selects
a
large number, I want to split these into smaller, referenced multiple
objects. My problem is how to do this and ensure I reference each
correctly.

Following demonstrates:

Sub DupShapeNames()
Dim i As Long
Dim lft As Single, tp As Single
Dim wd As Single, ht As Single
Dim obj As Object
Dim ws As Worksheet
Set ws = ActiveSheet

ws.DrawingObjects.Delete 'delete all objects
With [b2]
lft = .Left: tp = .RowHeight
wd = .Width * 1.5: ht = tp * 1.5
End With

With ws.Shapes
For i = 1 To 4
With .AddShape(1, lft, tp, wd, ht)
.Name = "Rect_" & i
.TextFrame.Characters.Text = .Name
End With
tp = tp + ht * 2
Next
End With

ActiveSheet.DrawingObjects(Array(2, 3, 4)).Copy
[f5].Select
ActiveSheet.Paste 'these have duplicate names
[a1].Select

''simulate user selection or more than two
''objects with duplicate names
ws.DrawingObjects(Array(5, 6, 7)).Select

'Stop ''look at selection

'' want to reference [say] the first two selected objects
Set obj = Selection
Dim v(1 To 2)
For i = 1 To UBound(v)
v(i) = obj(i).Name
Next

Set obj = ws.DrawingObjects(v)
obj.Select
''## The problem - objects 2 & 3 are ref'd, not 5 & 6

''''''''''''
'' Duplicate names also appear to have same index
'' shame! if unique problem is easily solved
i = 0
For Each obj In ws.DrawingObjects
i = i + 1
Debug.Print i; obj.Name, obj.Index
Next

End Sub

Also, need to cater for any type or mixture of selected types, not just
rectangles.

TIA,
Peter T