names shapes (2002)

Topic

New Reply

Is it posible to name the different objects in my slide with custom names? example: I have 10 gif’s one on top of the other that I want to animate differently. Selecting eahc by original name is nightmare. I would like to name each .gif with significant names: Tom, Rick, etc.

Is there an equivalent of the excel goto command to select any shapes by name from a list?

Thank you

Reply | Quote

Replies

Regarding the naming of objects, yes, someone posted a way to do that using the Visual Basic Editor’s Immediate window. Unfortuntely I don’t remember the exact trick, but the general idea is:

ActivePresentation.Slides(SlideNumber).Shapes(ShapeNumber).Name = “My Shape Name”

There might be a shortcut to the “current slide,” but I don’t do enough PPT VBA to know.

Reply | Quote

Regarding the naming of objects, yes, someone posted a way to do that using the Visual Basic Editor’s Immediate window. Unfortuntely I don’t remember the exact trick, but the general idea is:

ActivePresentation.Slides(SlideNumber).Shapes(ShapeNumber).Name = “My Shape Name”

There might be a shortcut to the “current slide,” but I don’t do enough PPT VBA to know.

Reply | Quote

One thing that makes selecting easier is to just select any shape on the slide, then use the Tab key or Shift-Tab to cycle through the shapes until the one you want is selected.

Powerpoint does not care how a shape is named, so it is perfectly OK to name shapes as you desire. But, of course, powerpoint does not provide any support to do this! A Name box like Excel would be fantastic!

Here are three macros that may be of some use. Rather than adding them to each presentation, just create a presentation that only contains macros. If you keep this presentation open, then you can use the Macro-In dropdown in the RunMacro dialog to select the macro that you want.

All of this information is a little brief, so if you have problems, just reply back and we will give you more instructions.

Option Explicit
'
Sub nameShape()
Dim s As Shape
Dim strName As String
    With ActiveWindow.Selection
        Select Case .Type
        Case msoAutoShape, msoCallout, msoChart, _
            msoComment, msoEmbeddedOLEObject, _
            msoFormControl, msoFreeform, _
            msoGroup, msoLine, msoLinkedOLEObject, _
            msoLinkedPicture, msoMedia, _
            msoOLEControlObject, msoPicture, _
            msoPlaceholder, msoScriptAnchor, _
            msoShapeTypeMixed, msoTable, _
            msoTextBox, msoTextEffect
            If .ShapeRange.Count = 1 Then
              strName = InputBox( _
                "Enter a name for the selected shape.", _
                "Rename Shape", _
                .ShapeRange(1).Name)
            Else
                MsgBox "Please select a single shape!"
            End If
            On Error Resume Next
                .ShapeRange(1).Name = strName
            On Error GoTo 0
        Case Else
            MsgBox "Please select a shape first!"
        End Select
    End With
End Sub
'
Sub gotoShape()
Dim i As Long, strName As String
Dim s As Shape
    strName = InputBox("Find a shape named: ", _
                "Go To Shape")
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If s.Name = strName Then
                    ActiveWindow.View.GotoSlide i
                    s.Select
                End If
            Next s
        Next i
    End With
End Sub
'
Sub listShapes()
Dim list As TextRange, s As Shape
Dim i As Long

    ActiveWindow.View.GotoSlide _
        Index:=ActivePresentation.Slides _
            .Add(Index:=10, _
                Layout:=ppLayoutText).SlideIndex
    With ActiveWindow.Selection
        With .SlideRange.Shapes("Rectangle 2")
            .TextFrame.TextRange.Text = "Named Shapes"
        End With
        With .SlideRange.Shapes("Rectangle 3")
            Set list = .TextFrame.TextRange
            list.Text = ""
        End With
        .Unselect
    End With
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If Not IsNumeric(Right(s.Name, 1)) Then
                    list.Text = list.Text & s.Name & vbCr
                End If
            Next s
        Next i
    End With
    Set list = Nothing
End Sub

Reply | Quote

One interesting way to name objects (well, kinda) is to right-click them, go to Format/Object , and in the Web tab, type some text in the “alternative text” box.

Then, if you use the Select Multiple Objects tool (which you’ll probably have to add to your toolbar), you can see that additional text along with the original name.

For instance, I draw an oval on the slide, go to Format/Autoshape, and in the Web tab, type green circle in the Alternative Text box.

Then I click the Select Multiple Objects tool, and my list reads:

Rectangle 2
Rectangle 3
Oval 4: green circle

It’s not code, and it’s not a solution for all situations, but it sure is a nice way to select objects and be sure you’re getting what you want.

Reply | Quote

That is a very nice trick! Even though I’m a programmer, I think that it is always best to avoid code.

BTW for the rest of you that have trouble comprending how to add the Select Multiple Objects tool (like I did — I was looking for a toolbar):

1. Right-click on the drawing toolbar and select Customize.
2. Click on the Commands tab and select the Drawing category
3. Drag the Select Multiple Objects command and drop it on the drawing toolbar (probably best to put it next to Select Objects button

This tool will be a permanent addition to my drawing toolbar. Thanks, Echo!

Reply | Quote

That is a very nice trick! Even though I’m a programmer, I think that it is always best to avoid code.

BTW for the rest of you that have trouble comprending how to add the Select Multiple Objects tool (like I did — I was looking for a toolbar):

1. Right-click on the drawing toolbar and select Customize.
2. Click on the Commands tab and select the Drawing category
3. Drag the Select Multiple Objects command and drop it on the drawing toolbar (probably best to put it next to Select Objects button

This tool will be a permanent addition to my drawing toolbar. Thanks, Echo!

Reply | Quote

just as a side note: the name from the Web tab is not the name (property) that VBA knows the shape as. But a very neat trick nonetheless and certainly has its uses.

Fred

Reply | Quote

> the Web tab is not the name
True, but it is easy to write a macro to rename all of the shapes that have a valid Web alternative text:

Sub renameShapes()
' Sets shape name to Web text
' and deletes the Web text
Dim s As Shape
Dim i As Long
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If s.AlternativeText  "" Then
                    On Error Resume Next
                    s.Name = s.AlternativeText
                    s.AlternativeText = ""
                    On Error GoTo 0
                End If
            Next s
        Next i
    End With
End Sub

Reply | Quote

Sammy,

Excellent – we can have our cake and eat it too. Yummm.

Fred

Reply | Quote

Sammy,

Excellent – we can have our cake and eat it too. Yummm.

Fred

Reply | Quote

Sammy,

Just took a better look at your code. Why not leave the AlternativeText as is rather than nulling it out? You are cycling thru all the shapes so it’s not like you’d run into the same shape again. Of course, a user might look at the PPT UI and wonder what happened to the web tag he/she assigned. On the other hand, the macro might be run twice. Maybe a check would be to see if the Name property had one of those “standard” VBA names (eg, Rectangle 1) before making the assignment. Oh well, I’m sure there’s lots of ways to hack this

Fred

Reply | Quote

> Why not leave the AlternativeText as is rather than nulling it out?
I didn’t like seeing it twice in Select Multiple box. You can delete that line of code if you want.

> a check would be to see if the Name property had one of those “standard” VBA names
I was going to add that code but then you would not be able to rename a shape that you had already named. If you want a check like that, then just use the line in the listShapes macro:

 If Not IsNumeric(Right(s.Name, 1)) Then 

Reply | Quote

> Why not leave the AlternativeText as is rather than nulling it out?
I didn’t like seeing it twice in Select Multiple box. You can delete that line of code if you want.

> a check would be to see if the Name property had one of those “standard” VBA names
I was going to add that code but then you would not be able to rename a shape that you had already named. If you want a check like that, then just use the line in the listShapes macro:

 If Not IsNumeric(Right(s.Name, 1)) Then 

Reply | Quote

Sammy,

Just took a better look at your code. Why not leave the AlternativeText as is rather than nulling it out? You are cycling thru all the shapes so it’s not like you’d run into the same shape again. Of course, a user might look at the PPT UI and wonder what happened to the web tag he/she assigned. On the other hand, the macro might be run twice. Maybe a check would be to see if the Name property had one of those “standard” VBA names (eg, Rectangle 1) before making the assignment. Oh well, I’m sure there’s lots of ways to hack this

Fred

Reply | Quote

> the Web tab is not the name
True, but it is easy to write a macro to rename all of the shapes that have a valid Web alternative text:

Sub renameShapes()
' Sets shape name to Web text
' and deletes the Web text
Dim s As Shape
Dim i As Long
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If s.AlternativeText  "" Then
                    On Error Resume Next
                    s.Name = s.AlternativeText
                    s.AlternativeText = ""
                    On Error GoTo 0
                End If
            Next s
        Next i
    End With
End Sub

Reply | Quote

just as a side note: the name from the Web tab is not the name (property) that VBA knows the shape as. But a very neat trick nonetheless and certainly has its uses.

Fred

Reply | Quote

One interesting way to name objects (well, kinda) is to right-click them, go to Format/Object , and in the Web tab, type some text in the “alternative text” box.

Then, if you use the Select Multiple Objects tool (which you’ll probably have to add to your toolbar), you can see that additional text along with the original name.

For instance, I draw an oval on the slide, go to Format/Autoshape, and in the Web tab, type green circle in the Alternative Text box.

Then I click the Select Multiple Objects tool, and my list reads:

Rectangle 2
Rectangle 3
Oval 4: green circle

It’s not code, and it’s not a solution for all situations, but it sure is a nice way to select objects and be sure you’re getting what you want.

Reply | Quote

I am trying Sub listShapes()

but it stops at :

ActiveWindow.View.GotoSlide _
Index:=ActivePresentation.Slides _
.Add(Index:=10, _
Layout:=ppLayoutText).SlideIndex

Can’t figure out why. Made sure I made no copy/paste mistakes. That is OK.

Anything wrong with the syntax?

Sub nameShape() works fine!

Reply | Quote

It looks OK to me. What is the error message? What view were you using in PowerPoint when you executed the macro? (Normal, Outline, Slide, Notes, etc.) I assumed Normal view when I created the macro. I suspect that some of the other views will be OK, but I doubt if the macro will work in Notes or Outline view. Thanks! –Sam

Reply | Quote

It looks OK to me. What is the error message? What view were you using in PowerPoint when you executed the macro? (Normal, Outline, Slide, Notes, etc.) I assumed Normal view when I created the macro. I suspect that some of the other views will be OK, but I doubt if the macro will work in Notes or Outline view. Thanks! –Sam

Reply | Quote

Never mind! I think that the problem is that the macro assumes that you have 9 slides. I’ll post a better macro in just a couple of minutes. Sorry! –Sam

Reply | Quote

Never mind! I think that the problem is that the macro assumes that you have 9 slides. I’ll post a better macro in just a couple of minutes. Sorry! –Sam

Reply | Quote

Thanks for finding that bug. I had used the macro recorder to generate some of the code and didn’t see the hard-coded 10. The macro would fail if you had less than 9 slides. Here’s the corrected copy:

Sub listShapes()
Dim list As TextRange, s As Shape
Dim i As Long

    ActiveWindow.View.GotoSlide _
        Index:=ActivePresentation.Slides _
            .Add(Index:=ActivePresentation.Slides.Count + 1, _
                Layout:=ppLayoutText).SlideIndex
    With ActiveWindow.Selection
        With .SlideRange.Shapes("Rectangle 2")
            .TextFrame.TextRange.Text = "Named Shapes"
        End With
        With .SlideRange.Shapes("Rectangle 3")
            Set list = .TextFrame.TextRange
            list.Text = ""
        End With
        .Unselect
    End With
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If Not IsNumeric(Right(s.Name, 1)) Then
                    list.Text = list.Text & s.Name & vbCr
                End If
            Next s
        Next i
    End With
    Set list = Nothing
End Sub

Reply | Quote

I edited it, and it ran to the end without error. . But now, the macro adds a new slide to the end of the presentation, with a title (“Named Shaped”) and an empty text box.

I guess that after …

ActiveWindow.View.GotoSlide _ Index:=ActivePresentation.Slides _ .Add(Index:=ActivePresentation.Slides.Count + 1, _ Layout:=ppLayoutText).SlideIndex

is it losing focus of the selected slide…for the next…

With ActiveWindow.Selection…..

Can you fix it?

(The new text box is bulleted and font size 32. Can you make font size 12 ?)

Thank you.

Reply | Quote

The listShapes macro only lists shapes that have a name that doesn’t end in a number; ie Rectangle1 will not be listed, but if you give Rectangle1 a new name of say, PriceInfo, then PriceInfo will be listed on the new slide. If you want all of the names, then comment out “If Not IsNumeric(Right(s.Name, 1)) Then” and the End If.”

If you want 12 point, then insert “list.Font.Size = 12” just before the final End With. HTH –Sam

Reply | Quote

EXCELLENT!!!

Thank you very much!

Reply | Quote

EXCELLENT!!!

Thank you very much!

Reply | Quote

The listShapes macro only lists shapes that have a name that doesn’t end in a number; ie Rectangle1 will not be listed, but if you give Rectangle1 a new name of say, PriceInfo, then PriceInfo will be listed on the new slide. If you want all of the names, then comment out “If Not IsNumeric(Right(s.Name, 1)) Then” and the End If.”

If you want 12 point, then insert “list.Font.Size = 12” just before the final End With. HTH –Sam

Reply | Quote

I edited it, and it ran to the end without error. . But now, the macro adds a new slide to the end of the presentation, with a title (“Named Shaped”) and an empty text box.

I guess that after …

ActiveWindow.View.GotoSlide _ Index:=ActivePresentation.Slides _ .Add(Index:=ActivePresentation.Slides.Count + 1, _ Layout:=ppLayoutText).SlideIndex

is it losing focus of the selected slide…for the next…

With ActiveWindow.Selection…..

Can you fix it?

(The new text box is bulleted and font size 32. Can you make font size 12 ?)

Thank you.

Reply | Quote

Thanks for finding that bug. I had used the macro recorder to generate some of the code and didn’t see the hard-coded 10. The macro would fail if you had less than 9 slides. Here’s the corrected copy:

Sub listShapes()
Dim list As TextRange, s As Shape
Dim i As Long

    ActiveWindow.View.GotoSlide _
        Index:=ActivePresentation.Slides _
            .Add(Index:=ActivePresentation.Slides.Count + 1, _
                Layout:=ppLayoutText).SlideIndex
    With ActiveWindow.Selection
        With .SlideRange.Shapes("Rectangle 2")
            .TextFrame.TextRange.Text = "Named Shapes"
        End With
        With .SlideRange.Shapes("Rectangle 3")
            Set list = .TextFrame.TextRange
            list.Text = ""
        End With
        .Unselect
    End With
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If Not IsNumeric(Right(s.Name, 1)) Then
                    list.Text = list.Text & s.Name & vbCr
                End If
            Next s
        Next i
    End With
    Set list = Nothing
End Sub

Reply | Quote

I am trying Sub listShapes()

but it stops at :

ActiveWindow.View.GotoSlide _
Index:=ActivePresentation.Slides _
.Add(Index:=10, _
Layout:=ppLayoutText).SlideIndex

Can’t figure out why. Made sure I made no copy/paste mistakes. That is OK.

Anything wrong with the syntax?

Sub nameShape() works fine!

Reply | Quote

One thing that makes selecting easier is to just select any shape on the slide, then use the Tab key or Shift-Tab to cycle through the shapes until the one you want is selected.

Powerpoint does not care how a shape is named, so it is perfectly OK to name shapes as you desire. But, of course, powerpoint does not provide any support to do this! A Name box like Excel would be fantastic!

Here are three macros that may be of some use. Rather than adding them to each presentation, just create a presentation that only contains macros. If you keep this presentation open, then you can use the Macro-In dropdown in the RunMacro dialog to select the macro that you want.

All of this information is a little brief, so if you have problems, just reply back and we will give you more instructions.

Option Explicit
'
Sub nameShape()
Dim s As Shape
Dim strName As String
    With ActiveWindow.Selection
        Select Case .Type
        Case msoAutoShape, msoCallout, msoChart, _
            msoComment, msoEmbeddedOLEObject, _
            msoFormControl, msoFreeform, _
            msoGroup, msoLine, msoLinkedOLEObject, _
            msoLinkedPicture, msoMedia, _
            msoOLEControlObject, msoPicture, _
            msoPlaceholder, msoScriptAnchor, _
            msoShapeTypeMixed, msoTable, _
            msoTextBox, msoTextEffect
            If .ShapeRange.Count = 1 Then
              strName = InputBox( _
                "Enter a name for the selected shape.", _
                "Rename Shape", _
                .ShapeRange(1).Name)
            Else
                MsgBox "Please select a single shape!"
            End If
            On Error Resume Next
                .ShapeRange(1).Name = strName
            On Error GoTo 0
        Case Else
            MsgBox "Please select a shape first!"
        End Select
    End With
End Sub
'
Sub gotoShape()
Dim i As Long, strName As String
Dim s As Shape
    strName = InputBox("Find a shape named: ", _
                "Go To Shape")
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If s.Name = strName Then
                    ActiveWindow.View.GotoSlide i
                    s.Select
                End If
            Next s
        Next i
    End With
End Sub
'
Sub listShapes()
Dim list As TextRange, s As Shape
Dim i As Long

    ActiveWindow.View.GotoSlide _
        Index:=ActivePresentation.Slides _
            .Add(Index:=10, _
                Layout:=ppLayoutText).SlideIndex
    With ActiveWindow.Selection
        With .SlideRange.Shapes("Rectangle 2")
            .TextFrame.TextRange.Text = "Named Shapes"
        End With
        With .SlideRange.Shapes("Rectangle 3")
            Set list = .TextFrame.TextRange
            list.Text = ""
        End With
        .Unselect
    End With
    With ActivePresentation.Slides
        For i = 1 To .Count
            For Each s In .Item(i).Shapes
                If Not IsNumeric(Right(s.Name, 1)) Then
                    list.Text = list.Text & s.Name & vbCr
                End If
            Next s
        Next i
    End With
    Set list = Nothing
End Sub

Reply | Quote