select specific objects by names or by nature

[iaudio1233]

Hi,

Is there any command or simple vba to select specific objects or images ?

case :
20 triangles in the names : "triangle1"....."triangle20" and 20 circles.."circle1"..."circle20"
a.just want to select the triangles
b. rename each to "shape01"...."shape20"


Regards,

iaudio1233

 

[MickG]

If these are "IsoscelesTriangles " then:-

[COLOR="Navy"]Sub[/COLOR] MG20Mar57
[COLOR="Navy"]Dim[/COLOR] shp [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] shp [COLOR="Navy"]In[/COLOR] ActiveSheet.Shapes
    [COLOR="Navy"]If[/COLOR] shp.AutoShapeType = msoShapeIsoscelesTriangle [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        shp.Name = "Shape" & Format(c, "00")
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] shp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[iaudio1233]

Hi, Mick

It comes an error highlighting from the word [ format ]
i am using 2003 version.
may this the reason ??
Regards,
iaudio1233

 

[MickG]

I really have no idea why the code should error out, so I have attached an example (.xls) showing 2 identical sheets with the , "Shapes" in the first sheet updated (Triangle Names changes) and the second , before update, hopefully this may be helpful to you.
https://app.box.com/s/60f79ly0jpjax9xeylsd
Regrds Mick

 

[iaudio1233]

Hi again Mick,

downloaded your file , it works perfectly . but when copy to my own, error again.give me some time to probe.
Let you know when solve.

Thanks lot lot.

regards,

iaudio1233

 

[iaudio1233]

Hi, Mick,
still not working , but I am now using your page as template to solve .

another question :

could you show me how to select the shapes of object by similar names ?

say I have some triangles and rectangles named :"ob_tri_01" and "ob_rec_01".. just want to select the shapes with the name "ob".
I have searched over the web but no similar threads.

Thanks.

Regards,
iaudio1233

 

[MickG]

When you say "Select" do you mean select them individually , or as a Group or just to do something with each shape that meets that criteria,????

 

[iaudio1233]

Mick,
thanks your reply.
Indeed I will manipulate these shapes for different results.

a. sometimes these selected shapes are push to the top level ( eg. Selection.ShapeRange.ZOrder msoBringToFront )
b. sometimes to the bottom
c. sometimes to delete

thats why I want to select those shapes first and do the second action.
Perhaps it's time to execute at same time

I found some code as per below but it does not work and return an error upon this line : ReDim Preserve myarr(n - 1)

Sub selectshapes()
Dim s As Shape, myarr(), n As Integer
ReDim myarr(ActiveSheet.Shapes.Count)
For Each s In ActiveSheet.Shapes
If Not InStr(s.Name, "Combo") = 0 Then
myarr = s.Name
n = n + 1
End If
Next
ReDim Preserve myarr(n - 1)
ActiveSheet.Shapes.Range(myarr).Select

End Sub

Thanks
Regards,
iaudio1233

 

[MickG]

I modified that code (It works for me!!!) to take account of your Criteria. I have also includes a msgbox to show how many shapes you have on the active sheet.
Your line that failed for you , indicates that the activesheet has no shapes that match the criteria. Instr(combo) bit!!!

Sub Sp()
Dim Shp As Shape, myarr(), n As Integer
ReDim myarr(ActiveSheet.Shapes.Count)
MsgBox UBound(myarr)
For Each Shp In ActiveSheet.Shapes
    If Left(Shp.Name, 2) = "ob" Then
        myarr(n) = Shp.Name
        n = n + 1
    End If
Next
ReDim Preserve myarr(n - 1)
ActiveSheet.Shapes.Range(myarr).Select
End Sub

 

[iaudio1233]

Hi,
Thanks lot lot lot , it works perfectly .
Saves me thousands of clicks and not missing one.

Regards,

iaudio1233