Renaming Drawings and Graphics

[LGFN]

How about a handy feature of renaming a drawing and graphics object, instead
of using the untill now - Oval 1, Oval 2, Oval 3, ..., Oval 72 ! (some
brainstorming memory game!).

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/com...aa8&dg=microsoft.public.word.drawing.graphics

 

[Bob Buckland ?:-\)]

Hi LGFN,

If you select an Autoshape or a picture by double clicking it or using Format=>Picture or Format=>Autoshape and go to the Web tab,
the 'Alternate text' you enter there will appear next to the shape name when you use the Select Multiple Objects tool that you
mentioned in another thread.

==========
How about a handy feature of renaming a drawing and graphics object, instead
of using the untill now - Oval 1, Oval 2, Oval 3, ..., Oval 72 ! (some
brainstorming memory game!). >>
--
Let us know if this helped you,

Bob Buckland ?
MS Office System Products MVP

Pricing and Packages for '2007 Microsoft Office System'
http://microsoft.com/office/preview

 

[LGFN]

Wow! that's something bravo! I never knew about it, and it will sure save me
a lot of time and let me be more organized. (I still think that instead of
showing i.e. Oval 1: top, it should just show my customized name, that would
be trully terrific and completley organized.)

 

[Ken Johnson]

Hi LGFN,

One way of changing a drawing object's name is...

1. Alt + F11 to get into the VBA Editor
2. View>Immediate window
3. To change the name of Oval 1 to EasterEgg type this into the
Immediate window then press enter...

activedocument.shapes("Oval 1").name= "EasterEgg"

Ken Johnson

 

[LGFN]

Excelent!! Thank you very much. But as it is self understood, if I am working
just on 3 or 4 shapes, I could certainly do it, but if I am working on a
project of 20 to 30 shapes or even more, I would finish with white hair. So
back to the first step, it WOULD certainly be a good idea for Microsoft to
make such a feature. And meanwhile I would like to ask anybody for a script
that could do this automaticly (like a dialog box asking me for a name).
Thanks!

 

[Ken Johnson]

Hi LGFN,

Have a go of this.
I struggle with the Word object model, so it took a bit of fiddling
around.
As it stands it's far from perfect.
However...

1. Select the shapes whose names you want to change.
It's best limiting the selection to currently visible shapes ie, don't
select some then scroll to another part of the document to select more,
causing the first lot of selections to scroll out of view. Reason for
this is, when the code is running the shape whose name you are about to
change will be the only selected shape. I haven't yet figured out code
that will scroll to an off screen selected shape, and I'm sure you
would want to be able to see the shape whose name you are about to
change.

2. Run the following macro.
The default input is the shape's original name so that if you change
your mind about changing its name you can just click OK.

Public Sub ReNameShapes()
Dim Shp As Shape
Dim I As Long
Dim ncShapes As New Collection
For Each Shp In Application.Selection.ShapeRange
ncShapes.Add Item:=Shp
Next
For Each Shp In ncShapes
Shp.Select
Application.ScreenRefresh
Shp.Name = InputBox(prompt:="Current Name:=" & Shp.Name, _
Title:="Rename This Shape", Default:=Shp.Name)
Next Shp
End Sub

Let me know how it goes.

Ken Johnson

 

[LGFN]

Thanks a trillion!! You're the best!! It's wonderfull!
There's just one small problem with it; it appears an End\Debug dialog box
by three times: (1) when I press Cancel, (2) when I leave the box empty and
press OK, and (3) when I mistankenly run the macro when nothing is selected.
Is there any way you can fix it? And again, thanks a trillion!!!

 

[Ken Johnson]

Hi LGFN,

That's the 'far from perfect' aspect

Errors 1 & 2 are dealt with using 'On Error Resume Next'.

Error 3 is dealt with by checking for shapes in the selection using...

'If Application.Selection.ShapeRange.Count <> 0 Then' at the start then
'End If' at the end.

These changes have been included in the following...

Public Sub ReNameShapes()
If Application.Selection.ShapeRange.Count <> 0 Then
Dim Shp As Shape
Dim I As Long
Dim ncShapes As New Collection
For Each Shp In Application.Selection.ShapeRange
ncShapes.Add Item:=Shp
Next
On Error Resume Next
For Each Shp In ncShapes
Shp.Select
Application.ScreenRefresh
Shp.Name = InputBox(prompt:="Current Name:=" & Shp.Name, _
Title:="Rename This Shape", Default:=Shp.Name)
Next Shp
End If
End Sub

Now it's a bit closer to perfect.

I've been looking into including the ability of scrolling to and
selecting out of view shapes so that they can all be renamed in one
fell swoop. No luck so far. I'll let you know when I have succeeded.

Ken Johnson

 

[Ken Johnson]

Hi LGFN,

If you prefer to let the user know they have forgotten to select shapes
before running the macro, rather than mysteriously have nothing happen
then use this version...

Public Sub ReNameShapes()
If Application.Selection.ShapeRange.Count <> 0 Then
Dim Shp As Shape
Dim I As Long
Dim ncShapes As New Collection
For Each Shp In Application.Selection.ShapeRange
ncShapes.Add Item:=Shp
Next
On Error Resume Next
For Each Shp In ncShapes
Shp.Select
Application.ScreenRefresh
Shp.Name = InputBox(prompt:="Current Name:=" & Shp.Name, _
Title:="Rename This Shape", Default:=Shp.Name)
Next Shp
Exit Sub
End If
MsgBox "You need to select the shapes before running this macro."
End Sub

Ken Johnson

 

[LGFN]

Thank you VERY VERY much! It works perfectly!! Just reread all the thanks I
gave you here and before, another 25 times!! I'm just wondering if I will use
it in the future Word 2007, or they will supply me with it.

 

[Ken Johnson]

Hi LGFN,

You're welcome.

Thanks for the feedback.

Ken Johnson