We help IT Professionals succeed at work.

Can I share just a custom show from a presentation

agwalsh asked
Last Modified: 2018-12-16
Is it possible to share just a custom show with someone else. I can see how to print it but if I wanted to show send someone just the custom show?
Watch Question

This one is on us!
(Get your first solution completely free - no credit card required)
Karen FalandaysTraining Specialist

Or just print your custom show to a PDF or One Note and email it
Jamie Garroch (MVP)PowerPoint Technical Consultant

This VBA macro will create a copy of the presentation and then delete any slides from it that are not in the specified custom show:

Option Explicit

' =================================================================================
' PowerPoint VBA Macro
' Copyright (c) 2018 BrigthCarbon Ltd.
' Source code is provide under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by BrigthCarbon (brightcarbon.com)"
' Commons Deed @ http://creativecommons.org/licenses/by/3.0/
' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode
' Purpose :  Save the slides from the specified custom show ID or name
' Author : Jamie Garroch of BrightCarbon (http://brightcarbon.com/)
' Date : 13DEC2018
' Inputs : either specif the numerical show ID or the name, not both.
' Outputs : creates a copy of the presentation in the same folder.
' =================================================================================
Sub SaveCustomShowAsPresentation(Optional lShowIdx As Long = 0, Optional tShowName As String = "")
  Dim oNSS As NamedSlideShow
  Dim lIdx As Long
  Dim tPath As String
  Dim oPres As Presentation
  Dim oSld As Slide
  Dim lSldIdx As Long, lTag As Long
  Dim arrSlideIDs() As Variant
  Dim bKeepSlide As Boolean
  On Error Resume Next
  ' Check that the custom show exists
  With ActivePresentation.SlideShowSettings.NamedSlideShows
    If lShowIdx <> 0 Then
      Set oNSS = .Item(lShowIdx) ' will raise error if custom shows doesn't exist
    ElseIf tShowName <> "" Then
      For lIdx = 1 To .Count
        If .Item(lIdx).Name = tShowName Then
          lShowIdx = lIdx
          Set oNSS = .Item(lIdx)
          Exit For
        End If
    End If
  End With
  ' If the specified custom show wasn't found, quit
  If oNSS Is Nothing Then
    MsgBox "Couldn't find the custom show named:" & vbCrLf & vbCrLf & _
           tShowName, vbCritical + vbOKOnly, "Custom Show not found"
    Exit Sub
  End If
  ' Create a copy of the presentation
  With ActivePresentation
    tPath = .Path & "\"
    .SaveCopyAs tPath & oNSS.Name & ".pptx", ppSaveAsOpenXMLPresentation
  End With
  ' Open the copy
  Set oPres = Presentations.Open(tPath & oNSS.Name & ".pptx")
  ' Iterate all slide IDs in the custom show, tagging slides that are in the show
  With oPres.SlideShowSettings.NamedSlideShows(lShowIdx)
    arrSlideIDs = .SlideIDs
    For lIdx = LBound(arrSlideIDs) To UBound(arrSlideIDs)
      For Each oSld In oPres.Slides
        If oSld.SlideID = arrSlideIDs(lIdx) Then oSld.Tags.Add "CUSTOM_SHOW", "TRUE": Exit For
  End With
  ' Iterate the slides again, deleting the untagged ones
  For lSldIdx = oPres.Slides.Count To 1 Step -1
    With oPres.Slides(lSldIdx).Tags
      For lTag = 1 To .Count
        If .Name(lTag) = "CUSTOM_SHOW" And .Value(lTag) = "TRUE" Then bKeepSlide = True
    End With
    If Not bKeepSlide Then oPres.Slides(lSldIdx).Delete Else bKeepSlide = False

  On Error GoTo 0
End Sub

' Example call
Sub ExportCustomShowOne()
  SaveCustomShowAsPresentation 1
End Sub

Open in new window


Thanks for this. I had thought that you couldn't share just the Show - I had thought of the PDF thing alright but at least I know now it wasn't just me not knowing :-)
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.