In a macro I'm working on, I allow the user to "store" selected items in a Shaperange, and also to select and add additional items to that Shaperange.
This is done so that the items in the ShapeRange can then be used to create an active selection at a later time.
At some points in time, I want to check to see if all of the items in that Shaperange still exist in the document. Specifically, if all of the items that were stored in the Shaperange were later deleted, I want to be able to disable the "Restore saved selection" button on the form.
Is there a way to check whether one of those referenced items still exists? So that I can "clean up" the Shaperange so that it only contains items that exist?
I could record the active selection, use the Shaperange to create a selection, set the Shaperange to that selection, then restore that saved selection - but that would create problems with my "responsive" macro.
You could make a quick for each shape in shaperange loop function and for each shape use a function like the one below..
if shapexists (shape) = false then shaperange.remove shape
Public Function ShapeExists(ByRef S1 As Shape) As Boolean On Error GoTo NotFound If S1.Name = S1.Name Then ShapeExists = True Exit Function NotFound: ShapeExists = False End Function
Thank you Howard! That works a treat.
I had tried to do it with error handling in the sub that I was writing to remove non-existing items from the shaperange, but made a right mess of it.
Putting the error handling part into a separate function as you did makes it neat and clean, and it was easy to get my sub working as desired with a simple Do loop.
Thanks again!
Howardhopkins said:You could make a quick for each shape in shaperange loop function and for each shape use a function like the one below..if shapexists (shape) = false then shaperange.remove shape
I did it using a Do loop and walking through the shaperange by index. When ShapeExists returns False, I remove the nonexistent shape by index.
Public Sub SR_remove_nonexisting(ByRef Shaperange As Shaperange)Dim lngSR_index As Long If Shaperange.Count > 0 Then lngSR_index = 1 Do If ShapeExists(Shaperange(lngSR_index)) = False Then Shaperange.Remove lngSR_index Else lngSR_index = lngSR_index + 1 End If Loop Until lngSR_index > Shaperange.Count End IfEnd Sub
I don't know that I could do that using a "for each shape in shaperange" approach. That would sometimes be trying to refer to a nonexistent shape, wouldn't it?