P
Peter T
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 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