Macro to bulk rename all objects in slide (or even whole presentation)?

[somedude]

Hi guys,

I am looking for a way to rename all objects in a given slide (titles, placeholders, images, shapes etc) in a way that's less time consuming that doing it manually on the selection pane.

I have to say that I'm 100% new to VBA, so my expectations might be unrealistic. Ideally, I would like something that can:


do the job automatically, renaming objects incrementally
do the job across all slides in one go
I often use groups, so something that rename both groups and their content would be great


If that's not possible, any help regarding other ways to achieve this is welcome.

I shall also add that I wouldn't mind some kind of detailed how-to, because I've tried using some of the code I've found online, but I didn't even manage to launch them. (something about unexpected End Sub if I recall correctly)

I hope that's not too much to ask for.

Thanks!

[Paul_Hossler]

What do you want to rename them to, and how are you defining "incrementally"?

[somedude]

Well, object numbers are kind of a mess, so I'd like to tidy them a bit, either from top to bottom or the other way around.

Current situation, in selection pane:
Placeholder27
Group45
_Text37
_Image22
Text39
Group27
_Placeholder39

What I would like:
Placeholder1
Group1
_Text1
_Image1
Text2
Group2
_Placeholoder2

So "incrementally" in this case would be +1 for each occurence of the same object type.

Thanks Paul

[Paul_Hossler]

This uses the enumerations from PP2016, so you might need to tweak it if you're using a different version





Option Explicit

Sub RenameThings()
Dim oPres As Presentation
Dim oSlide As Slide
Dim oShape As Shape, oOtherShape As Shape
Dim sPrefix As String
Dim n As Long
Dim bNameGood As Boolean

Set oPres = ActivePresentation

For Each oSlide In oPres.Slides

'reset any names that might match
n = 1
For Each oShape In oSlide.Shapes
oShape.Name = "temp_" & Format(n, "00")
n = n + 1
Next

'give each shape a nice name
For Each oShape In oSlide.Shapes
With oShape
Select Case .Type
Case msoAutoShape
sPrefix = "AutoShape_"
Case msoCallout
sPrefix = "Callout_"
Case msoCanvas
sPrefix = "Canvas_"
Case msoChart
sPrefix = "Chart_"
Case msoComment
sPrefix = "Comment_"
Case msoContentApp
sPrefix = "ContentApp_"
Case msoDiagram
sPrefix = "Diagram_"
Case msoEmbeddedOLEObject
sPrefix = "EmbeddedOLEObject_"
Case msoFormControl
sPrefix = "FormControl_"
Case msoFreeform
sPrefix = "Freeform_"
Case msoGroup
sPrefix = "Group_"
Case msoInk
sPrefix = "Ink_"
Case msoInkComment
sPrefix = "InkComment_"
Case msoLine
sPrefix = "Line_"
Case msoLinkedOLEObject
sPrefix = "LinkedOLEObject_"
Case msoLinkedPicture
sPrefix = "LinkedPicture_"
Case msoMedia
sPrefix = "Media_"
Case msoOLEControlObject
sPrefix = "OLEControlObject_"
Case msoPicture
sPrefix = "Picture_"
Case msoPlaceholder
sPrefix = "PlaceHolder_"
Case msoScriptAnchor
sPrefix = "ScriptAnchor_"
Case msoShapeTypeMixed
sPrefix = "ShapeTypeMixed_"
Case msoSlicer
sPrefix = "Slicer_"
Case msoSmartArt
sPrefix = "SmartArt_"
Case msoTable
sPrefix = "Table_"
Case msoTextBox
sPrefix = "Textbox_"
Case msoTextEffect
sPrefix = "TextEffect_"
Case msoWebVideo
sPrefix = "WebVideo_"
Case Else
sPrefix = "Other_"
End Select

For n = 1 To 1000
bNameGood = True
For Each oOtherShape In oSlide.Shapes
If oOtherShape.Name = sPrefix & Format(n, "00") Then
bNameGood = False
Exit For
End If
Next

If bNameGood Then
oShape.Name = sPrefix & Format(n, "00")
Exit For
End If
Next n

End With
Next
Next
End Sub

[somedude]

You have no idea how grateful I am Paul, thanks a lot.

However, it doesn't rename objects in groups, though it renames the group itself.

Is there a way to rename those too ?

I'm using PP2013.

Thanks again !

edit: and thank mark007 too.

[Paul_Hossler]

1. I moved some common code into seperate subs/functions







Option Explicit
Sub RenameThings()
Dim oPres As Presentation
Dim oSlide As Slide
Dim oShape As Shape, oGroupedShape As Shape
Dim sPrefix As String
Dim n As Long

Set oPres = ActivePresentation

For Each oSlide In oPres.Slides

'reset any names that might match
n = 1
For Each oShape In oSlide.Shapes
oShape.Name = "temp_" & Format(n, "00")
n = n + 1
If oShape.Type = msoGroup Then
For Each oGroupedShape In oShape.GroupItems
oGroupedShape.Name = "temp_" & Format(n, "00")
n = n + 1
Next
End If
Next

'give each shape a nice name
For Each oShape In oSlide.Shapes
Call pvtRenameShape(oShape)
If oShape.Type = msoGroup Then
For Each oGroupedShape In oShape.GroupItems
Call pvtRenameGroupedShape(oGroupedShape, oShape)
Next
End If
Next
Next
End Sub

Private Sub pvtRenameShape(oShape1 As Shape)
Dim n As Long
Dim bNameGood As Boolean
Dim oShape As Shape
Dim sPrefix As String

sPrefix = pvtShapeType(oShape1)

For n = 1 To 1000
bNameGood = True
For Each oShape In oShape1.Parent.Shapes
If oShape.Name = sPrefix & "_" & Format(n, "00") Then
bNameGood = False
Exit For
End If
Next

If bNameGood Then
oShape1.Name = sPrefix & "_" & Format(n, "00")
Exit For
End If
Next n
End Sub
Sub pvtRenameGroupedShape(oGroupedShape1 As Shape, oShape1 As Shape)
Dim n As Long
Dim bNameGood As Boolean
Dim sPrefix As String
Dim oShape As Shape

sPrefix = pvtShapeType(oGroupedShape1)

For n = 1 To 1000
bNameGood = True
For Each oShape In oShape1.GroupItems
If oShape.Name = sPrefix & "_" & Format(n, "00") Then
bNameGood = False
Exit For
End If
Next

If bNameGood Then
oGroupedShape1.Name = sPrefix & "_" & Format(n, "00")
Exit For
End If
Next n

End Sub

Private Function pvtShapeType(oShape1 As Shape) As String

Select Case oShape1.Type
Case msoAutoShape
pvtShapeType = "AutoShape"
Case msoCallout
pvtShapeType = "Callout"
Case msoCanvas
pvtShapeType = "Canvas"
Case msoChart
pvtShapeType = "Chart"
Case msoComment
pvtShapeType = "Comment"
Case msoContentApp
pvtShapeType = "ContentApp"
Case msoDiagram
pvtShapeType = "Diagram"
Case msoEmbeddedOLEObject
pvtShapeType = "EmbeddedOLEObject"
Case msoFormControl
pvtShapeType = "FormControl"
Case msoFreeform
pvtShapeType = "Freeform"
Case msoGroup
pvtShapeType = "Group"
Case msoInk
pvtShapeType = "Ink"
Case msoInkComment
pvtShapeType = "InkComment"
Case msoLine
pvtShapeType = "Line"
Case msoLinkedOLEObject
pvtShapeType = "LinkedOLEObject"
Case msoLinkedPicture
pvtShapeType = "LinkedPicture"
Case msoMedia
pvtShapeType = "Media"
Case msoOLEControlObject
pvtShapeType = "OLEControlObject"
Case msoPicture
pvtShapeType = "Picture"
Case msoPlaceholder
pvtShapeType = "PlaceHolder"
Case msoScriptAnchor
pvtShapeType = "ScriptAnchor"
Case msoShapeTypeMixed
pvtShapeType = "ShapeTypeMixed"
Case msoSlicer
pvtShapeType = "Slicer"
Case msoSmartArt
pvtShapeType = "SmartArt"
Case msoTable
pvtShapeType = "Table"
Case msoTextBox
pvtShapeType = "Textbox"
Case msoTextEffect
pvtShapeType = "TextEffect"
Case msoWebVideo
pvtShapeType = "WebVideo"
Case Else
pvtShapeType = "Other"
End Select
End Function

[somedude]

working perfectly.

Thanks a lot Paul.