Remove Shape from Collection

[John]

Hi there,

I'm getting stuck with Collections:

I'm trying to write a procedure to sort the active selection of shapes into
alphabetical order based on the shapes text (Prop.Name). The sorted list
has been passed to an array (colShps) and works fine if there are no shapes
with the same name (text). I've therefore tried to create a collection,
from the selection, so that when an instance is found (strFoundName) it can
be removed from the collection there by not moving the same shape twice.

The code below is falling over at the "colSelColShps.Remove strFoundName"
row with a Run time error '5': "Invalid procedure or arguement".

It's hot and humid and my head hurts. Can anyone help?

Best regards

John



For Each shp In sel
colSelColShps.Add shp
Debug.Print CStr(shp)
Next shp

For Each x In colShps
Debug.Print CStr(x)
For z = 1 To colSelColShps.Count
If x = colSelColShps.Item(z).Cells("Prop.Name").ResultStr("") Then
strFoundName = colSelColShps.Item(z)
If colSelColShps.Item(z).Master.Name = "Square" Then
colSelColShps.Item(z).Cells("PinX") = topPinX
newPositionY = lastShpTop -
((colSelColShps.Item(z).Cells("Height")) * 0.5)
colSelColShps.Item(z).Cells("PinY") = newPositionY
lastShpTop = newPositionY -
((colSelColShps.Item(z).Cells("Height")) * 0.5)
End If
End If
Next z
colSelColShps.Remove strFoundName
Next x

 

[JuneTheSecond]

I dont know what is the complete answer, but the text which is the same
string as in the custom property would be obtained by characters property, as
shp.Characters.Text. And if you remove one item from your collection, the
index following after removed item changes, so the code may become like a,
For I = 1 To colSelColShps.Count - 1
If txt = colSelColShps.Item(I).Characters.Text Then
colSelColShps.Remove I
End If
Next

 

[John]

Hi June,

Thanks for this. I understand that the index changes if you remove an item
form the collection, but I think the issue here is using a string as an
index for the Remove method. IDE help says:

 

[John]

Hi June,

Thanks for this. I understand that the index changes if you remove an item
form the collection (which is why I placed the remove item outside the "For
z = ..." loop), but I think the issue here is using a string as an
index for the Remove method. IDE help says:

"If a string expression, index must correspond to the key argument specified
when the member referred to was added to the collection."

......but does this mean that I'm using the string index in the correct way?
I'm afraid I don't quite follow the help (above).

Thanks

John

 

[JuneTheSecond]

Sorry, then at the "colSelColShps.Add shp" the key would be wished to be
added like,
On Error Resume Next
colSelColShps.Add shp, shp.Characters.Text
.....
On Error GoTo 0 ' Out side the for loop.
This colSelColShps would not have shapes with duplicated text.
It may bring the result what you want.

 

[JuneTheSecond]

I've tested like this and this seemed good.

Option Explicit

Sub test()
Dim shp As Visio.Shape
Dim x As Visio.Shape
Dim sel As Visio.Selection
Dim colSelColShps As Collection
Dim z As Long
Dim strFoundName As String
Dim topPinX As Double, lastShpTop As Double, newPositionY As Double

Set colSelColShps = New Collection

Set sel = ActiveWindow.Selection
For Each shp In sel
On Error Resume Next
colSelColShps.Add shp, shp.Characters.Text
Next shp
On Error GoTo 0
For Each x In colSelColShps
For z = 1 To colSelColShps.Count
Debug.Print colSelColShps.Item(z).Cells("Prop.Name").ResultStr(""),
x.Characters.Text
If x.Characters.Text =
colSelColShps.Item(z).Cells("Prop.Name").ResultStr("") Then
strFoundName = colSelColShps.Item(z).Characters.Text
Debug.Print "**** " & strFoundName
' If colSelColShps.Item(z).Master.Name = "Square" Then
colSelColShps.Item(z).Cells("PinX") = topPinX
newPositionY = lastShpTop -
((colSelColShps.Item(z).Cells("Height")) * 0.5)
colSelColShps.Item(z).Cells("PinY") = newPositionY
lastShpTop = newPositionY -
((colSelColShps.Item(z).Cells("Height")) * 0.5)
' End If
End If
Next z

Next x

End Sub