Rename Multiple Powerpoint Slides Using VBA

[dhouck]

Hello,

I am trying to rename multiple slide in a Powerpoint Presentation and then select those slides based on the names I have just given them to past into a new presentation. Here is what I have so far. Any help would be greatly appreciated!! - Dave

Sub Dist_Slicer()


Dim osource As Presentation
Dim otarget As Presentation

ActiveWindow.Selection.SlideRange(1).Name = "AV1"
ActiveWindow.Selection.SlideRange(5).Name = "AV2"
ActiveWindow.Selection.SlideRange(17).Name = "AV3"




'Data Range For Test File 1
Set osource = ActivePresentation
Set otarget = Presentations.Add


osource.Slides(AV1).Copy
otarget.Slides.Paste (otarget.Slides.Count + 1)


With Application.ActivePresentation
.SaveAs "Test File 1" & "_" & RptYear & "_" & RptMth, ppSaveAsDefault
End With


With Application.ActivePresentation


.Save


.Close


End With


End Sub

[John Wilson]

Maybe you need something like this:

Sub Dist_Slicer()
 Dim osource As Presentation
 Dim otarget As Presentation
'Data Range For Test File 1
 Set osource = ActivePresentation
 Set otarget = Presentations.Add
With osource
.Slides(1).Name = "AV1"
.Slides(5).Name = "AV2"
.Slides(17).Name = "AV3"
End With
 osource.Slides("AV1").Copy 'NOTE the ""
 otarget.Slides.Paste (otarget.Slides.Count + 1)
 With Application.ActivePresentation
 ' this need to be a full path not just the name
 .SaveAs "Test File 1" & "_" & RptYear & "_" & RptMth, ppSaveAsDefault
 End With

 With Application.ActivePresentation
 .Save
 .Close
 End With
 End Sub

[dhouck]

So I was able to figure out the pasting of multiple sheets code. However, if I run this code more than once on the same document, it errors out and states another slide already has the name. How do I get it to rename everything regardless of what the current naming is? Here is the way things look right now. Again, I really appreciate the help!

Sub Dist_Slicer()
Dim osource As Presentation
Dim otarget As Presentation
'Data Range For Test File 1
Set osource = ActivePresentation
Set otarget = Presentations.Add
With osource
.Slides(1).Name = "AV1"
.Slides(5).Name = "AV2"
.Slides(17).Name = "AV3"
End With
osource.Slides("AV1").Copy 'NOTE the ""
otarget.Slides.Paste (otarget.Slides.Count + 1)
osource.Slides("AV2").Copy 'NOTE the ""
otarget.Slides.Paste (otarget.Slides.Count + 1)
osource.Slides("AV3").Copy 'NOTE the ""
otarget.Slides.Paste (otarget.Slides.Count + 1)
With Application.ActivePresentation
' this need to be a full path not just the name
.SaveAs "Test File 1" & "_" & RptYear & "_" & RptMth, ppSaveAsDefault
End With

With Application.ActivePresentation
.Save
.Close
End With
End Sub

[John Wilson]

Slides names must be unique so you must be trying to name other slides with an existing name. You need to explain why.

If you just need to split out 1,5 and 17 you don't need to name at all/

Sub chex()
Dim osource As Presentation
Dim otarget As Presentation
Set osource = ActivePresentation
Set otarget = Presentations.Add
osource.Slides.Range(Array(1, 5, 17)).Copy
Set otarget = Presentations.Add
otarget.Slides.Paste (otarget.Slides.Count + 1)
End Sub

If it's something else you need to explain clearly exactly what you are trying to do.