Using variables inside .Slides & .Shapes methods in Powerpoint VBA

Question

I am working on an interactive Powerpoint Presentation where the user will click on a thumbnail of photo and be able to view it nearly full screen. I'm having difficulty with .Shapes and .Slides methods.

I want several smaller images to appear on one slide in the presentation. If the user wants to view it very large they just need to click on the image. I would then like the image to appear on it's own newly generated slide as large as it can fit on that slide. When they click the larger image, they will be taken back to the smaller images slide they were viewing. This is easily enough achieved by making a separate full sized image slide for every small image in the show and simply calling the large slide number when the small image is clicked; however it is time consuming and makes the presentation far larger than it needs to be. If a user never clicks to see the enlarged image, then the page with the large image is taking up space. I've opted to execute vba code when an image is clicked on that is supposed to:

1. copy the image

2. create a new slide after the last slide in the presentation

3. paste the image into the new slide

4. resize the image as large as it can fit on the screen
5. view the new slide with larger image
6. send the user back to the slide they started on.

Code:

Sub ViewFullSize()

    Dim pptNewSlide As Slide
    ' Dim objCurrentSlideIndex As Integer

    ' objCurrentSlideIndex = ActiveWindow.Selection.SlideRange.SlideIndex

    With ActivePresentation

        .Slides(2).Shapes("Picture 7").Copy

        .Slides(4).Shapes.Paste

    End With


    Set pptNewSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)

    ActivePresentation.SlideShowWindow.view.Last

End Sub

This code executes and does what is epected. My issue is, I need the slide numbers and shape numbers to be variables. I don't want to rewrite this snippet of code for 100's of photos that could be clicked on. I've tried to make the current slide a variable like this:

    Dim objCurrentSlideIndex As Integer
    objCurrentSlideIndex = ActiveWindow.Selection.SlideRange.SlideIndex
    With ActivePresentation
        .Slides(objCurrentSlideIndex).Shapes("Picture 7").Copy
        .Slides(4).Shapes.Paste`
    End With

The variable I tried .Slides(objCurrentSlideIndex) causes the whole subroutine not to execute, but doesn't crash the slideshow. I've used Set and a slew of other syntax and can't get it to use a variable instead of a plain number. Is there a way to do this? Can the .Slides() and .Shapes() methods even use variables? I've read several of Microsoft's and PPTools pages, but can find no examples using variables.

Answer 1

Sub ViewFullSize(objCurrentShape As Shape) ' Place shape clicked on into variable.

    Dim pptNewSlide As Slide
    Dim objCurrentSlideNum As Integer
    Dim objLastSlideNum As Integer

' Place current slide number into a variable.
    objCurrentSlideNum = ActivePresentation.SlideShowWindow.view.CurrentShowPosition

' Send shape to clipboard for later pasting.
    ActivePresentation.Slides(objCurrentSlideNum).Shapes(objCurrentShape.Name).Copy

' Place new blank slide at the end of the presentation.
    Set pptNewSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)

' Make the new slide the active slide.
    ActivePresentation.SlideShowWindow.view.Last

' Place the new slide number into a variable.
    objLastSlideNum = ActivePresentation.SlideShowWindow.view.CurrentShowPosition

' Paste the shape image from the clipboard onto the new slide.
    ActivePresentation.Slides(objLastSlideNum).Shapes.Paste

End Sub

I stumbled onto a snippet of code that showed when a shape was clicked, it could pass its identifiers directly into the subroutine and be assigned to a variable. In my case (objCurrentShape As Shape). This could then be used with the .Shapes() method that I used to call the shape for copying .Shapes(objCurrentShape.Name).Copy.

The .Slides() method was simpler to assign to a variable (or so I believe) because it was not dependent on which shape was clicked. It's merely the active slide number and was attained with the .View.CurrentShowPosition function.

This code can now be assigned to any number of shapes on a slide and will copy and past that shape to a newly created blank slide at the end of your presentation for further manipulations.

Answer 2

Fully working code!

For anyone interested this is the finished (maybe not gleaned), fully operational code that I have working in Powerpoint 2017.

This was designed to be assigned as a Macro Action to pictures in a slideshow. When there are multiple smaller sized images on a page, they can each be assigned this one macro that will show the image full screen on it's own slide and then send the user right back to the screen they were on that contains the smaller images. It's sort of like a full screen zoom function.

It's documented as well as I can document to allow anyone to follow allong with what's taking place at each step. Edits for proper wording and terminology are welcome if I have stated anything incorrectly.

This is not specific to my machine or paths or anything like that. You can simply copy and paste into a module in powerpoint and start assigning the new macro to any images in your presentation.

Sub ViewFullSize(objCurrentShape As Shape) ' Place shape clicked-on into variable.
 ' Credit Shyam Pillai @ http://www.skphub.com/ppt00040.htm#2 for the method of
 ' bringing the shape into the macro as a variable allowing easier manipulation.

    Dim pptNewSlide As Slide
    Dim objCurrentSlideNum As Integer
    Dim objLastSlideNum As Integer
    Dim objLargeView As Shape

' Place current slide number into a variable.
    objCurrentSlideNum = ActivePresentation.SlideShowWindow.view.CurrentShowPosition

' Copy shape to clipboard for later pasting.
    ActivePresentation.Slides(objCurrentSlideNum).Shapes(objCurrentShape.Name).Copy

' Place new blank slide at the end of the presentation.
    Set pptNewSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

' Make the new slide the active slide.
    ActivePresentation.SlideShowWindow.view.Last

' Place the new slide number into a variable.
    objLastSlideNum = ActivePresentation.SlideShowWindow.view.CurrentShowPosition

' Paste the shape image from the clipboard onto the new slide.
    ActivePresentation.Slides(objLastSlideNum).Shapes.Paste

' Put pasted image into a variable.
    Set objLargeView = ActivePresentation.Slides(objLastSlideNum).Shapes(1)

' Full credit for this next section of the code goes to PPTools & David Marcovitz
' @ http://www.pptfaq.com/FAQ00352_Batch_Insert_a_folder_full_of_pictures-_one_per_slide.htm
' Thanks for the hard work!

' Manipulate the image using the variable.
    With objLargeView
      ' Set mouse-click action on image to return user back to the slide they came from.
        .ActionSettings(ppMouseClick).Action = ppActionLastSlideViewed
      ' Reposition the image for proper resizing
        .Left = 0
        .Top = 0
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
      ' Resize the image to full screen while maintaining aspect ratio.
      ' This is wide screen mode.  If you are working with the more
      ' narrow mode, simply change the 9 to a 3 and the 16 to a 4
      ' to keep the correct aspect ratio.
        If 9 * .Width > 16 * .Height Then
            .Width = ActivePresentation.PageSetup.SlideWidth
            .Top = 0.5 * (ActivePresentation.PageSetup.SlideHeight - .Height)
        Else
            .Height = ActivePresentation.PageSetup.SlideHeight
            .Left = 0.5 * (ActivePresentation.PageSetup.SlideWidth - .Width)
        End If
    End With
' From here, the slideshow is now showing the originally clicked-on image
' full screen on its own page waiting for the user to click on it to return
' to the rest of the show.  If the slideshow isn't set to kiosk mode, then
' there is the possibility of the user clicking somewhere on the screen out
' of the picture area and it would end the slideshow.
End Sub