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:
copy the image
create a new slide after the last slide in the presentation
paste the image into the new slide
resize the image as large as it can fit on the screen
view the new slide with larger image
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.
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.
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
Related
I am trying to create a new slide and name it at the same time using VBA. I have a main menu page that contains shapes with text labels in them. I've set the action for each shape to run the following macro: It is intended to create a new slide and name it the same as the category name that is shown in text on the button the user clicked.
Sub ChangeSlideName(objCurrentShape As Shape) ' Place the clicked on shape in a variable.
Dim objTextInBox As String
Dim objCurrentSlideNum As Integer
' Place current slide number into a variable.
objCurrentSlideNum = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
' Set value of string variable to the text in the shape clicked on.
objTextInBox = ActivePresentation.Slides(objCurrentSlideNum).Shapes(objCurrentShape.Name).TextFrame.TextRange.Text
' Create a new 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
' Set the name of the new slide to the text contained on the button clicked.
ActiveWindow.View.Slide.Name = objTextInBox
End Sub
My code runs and takes me to the newly created slide; however, I don't know how to tell if it actually named the new slide. Because I'm using a variable to name the slide, I suspect it isn't working. When I run another macro from a different slide, it will not jump me to the slide I renamed. I also use a variable to identify the name of the slide I am trying to jump to. I've tried all 4 of the following commands one at a time.
' Take user to the page of the category clicked on.
SlideShowWindows(1).View.GotoSlide GetSlideIndex(objTextInBox)
ActivePresentation.SlideShowWindow.View.GotoSlide (objTextInBox)
SlideShowWindows(1).View.GotoSlide GetSlideIndex(objTextInBox), 1
ActivePresentation.Slides(objTextInBox).Select
Am I missing something in my code like parenthesis or quotation marks or something? Can I not use a variable in place of a literal string like "New Slide Name"? Also, can someone tell me how to verify the name of a slide?
These work for Powerpoint-2010. I haven't tried it in other version.
When a user clicks on a shape (in my case it's a rectangle with text inside that shows a category name) this code will create a new slide and name it whatever category name was in the shape clicked on.
Sub ChangeSlideName(objClickedShape As Shape) ' Place the clicked on shape in a variable.
Dim objText As String
Dim objSlideNum As Integer
Dim pptNewSlide
' Place current slide number into a variable.
objSlideNum = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
' Set value of string variable to the text in the shape clicked on.
objText = ActivePresentation.Slides(objSlideNum).Shapes(objClickedShape.Name).TextFrame.TextRange.Text
' Create a new 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
' Change slide # variable to the number of the newly created slide.
objSlideNum = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
' Set the name of the new slide to the text contained on the button clicked.
ActivePresentation.Slides(objSlideNum).Name = objText
End Sub
This is the command that will jump to the newly created slide using the variable:
Dim osld As Slide
Set osld = ActivePresentation.Slides(objTextInBox)
SlideShowWindows(1).View.GotoSlide (osld.SlideIndex)
This allows me to use one macro to jump between slides by using the slide names as the text written in the shapes in the presentation.
I was trying to write a VBA macro to align an image to the top right corner of the page and set text wrapping to "Behind Text" and "Fixed Position on Page."
Normally I select the image and do all those settings through dialog boxes. But it gets tedious after a while. I'm wondering if there's a way to do it programmatically. I'm hoping I could open the page header, paste in my header image, and then click a macro button to have the macro align the still-selected image.
I tried recording a macro of my operations, but the macro did not record any of my dialog actions (behind text, fixed page position, etc). So that method provided no solution. I tried it with images inside and outside of page headers, without success.
Is it possible to have some VBA code align the currently selected image object? Ideally, I would open up the page header, paste in my header image, and run a VBA macro to do the four operations above (behind text, fixed position on page, align top to page, align right side to page). I'm hoping someone can show me how or point me to some documentation or examples that show how to do it.
UPDATE
I couldn't post to the forum for some reason, so I worked on the problem for a couple of days and finally pieced together this solution for the next person. I wish I knew where to look in a manual or tutorial for this kind of thing.
But the only way seems to be to cobble solutions together from forums on the net. Here's my contribution! :-)
Sub AlignTopRight()
' Paste an image into Word so it is still selected
' Then invoke this macro to align it to the top right corner
' And to set it behind text, fixed position on the page
Application.ScreenUpdating = False
Dim Shp As Shape
On Error Resume Next
'I'm not sure if this block is required, but it works
Set Shp = Selection.InlineShapes(1)
If Not Shp Is Nothing Then
Set Shp = Selection.InlineShapes(1).ConvertToShape
Else
Set Shp = Selection.ShapeRange.Item(1)
End If
If Not Shp Is Nothing Then
With Shp
.LockAspectRatio = True
' for absolute positioning
'.Left = CentimetersToPoints(5.5)
'.Top = CentimetersToPoints(0.5)
'.Width = CentimetersToPoints(2.5)
'put the image behind text
.WrapFormat.Type = wdWrapBehind
'this was the tricky part, discovering this
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop 'if you say =0, it sets the AbsolutePx in the dialog
.Left = wdShapeRight 'these wdShapeXX objects set the Align field in the dialog
End With
End If
Set Shp = Nothing
Application.ScreenUpdating = True
End Sub
Just discovered this feature to answer my own question. See the answer in the question posting.
Trying to write a VBA excel macro that will allow me to insert a picture as a pop-up on mouseover of a cell.
I'm accomplishing this by inserting a comment in the cell and setting the comment's fill to be a specified picture.
I would like the picture to maintain its original scaling
After setting the comment to use the picture as a fill background, I can manually right-click the cell, click edit comment, right-click the comment, go to the "size" tab, select "Relative to original picture size" checkbox, and set scale height and size to be 100%, which achieves the desired effect, as shown below:
Recording a macro to see what the VBA to replicate this is results in nothing being recorded.
Using the targetComment.Shape.ScaleHeight 1, msoTrue results in an error:
Run-time error '-2147024891 (80070005)':
The RelativeToOriginalSize argument applies only to a picture or an OLE object
Here is a screenshot of the VBA code that generates this error:
Does anyone know how to access what is in the dialog box via VBA???
Using a comment to show an image with scaling can be done. The trick is to calculate the scaling factor yourself and apply it to the image. I've used the Windows Image Acquisition Automation Layer to access the image file's dimensions.
The example below accesses a JPG image in my Temp directory and adds it to a cell's comment with appropriate scaling.
Option Explicit
Sub test()
'--- delete any existing comment just for testing
If Not Range("C5").Comment Is Nothing Then
Range("C5").Comment.Delete
End If
InsertCommentWithImage Range("C5"), "C:\Temp\laptop.jpg", 1#
End Sub
Sub InsertCommentWithImage(imgCell As Range, _
imgPath As String, _
imgScale As Double)
'--- first check if the image file exists in the
' specified path
If Dir(imgPath) <> vbNullString Then
If imgCell.Comment Is Nothing Then
imgCell.AddComment
End If
'--- establish a Windows Image Acquisition Automation object
' to get the image's dimensions
Dim imageObj As Object
Set imageObj = CreateObject("WIA.ImageFile")
imageObj.LoadFile (imgPath)
Dim width As Long
Dim height As Long
width = imageObj.width
height = imageObj.height
'--- simple scaling that keeps the image's
' original aspect ratio
With imgCell.Comment
.Shape.Fill.UserPicture imgPath
.Shape.height = height * imgScale
.Shape.width = width * imgScale
End With
End If
End Sub
I need to be able to copy shapes (chart, table, etc.) programmatically from one slide to another in PowerPoint 2007 keeping their original colors. The source and destination slides are in different presentations which have different themes.
These shapes might be complex and include a lot of colors, e.g., charts, tables, etc. The destination slide must maintain its theme, so I cannot simply copy the entire original slide colorScheme.
When copying a shape manually in PowerPoint, I get an option to "Keep Source Formatting". This copies all the original colors of the shape, converting theme colors into absolute RGB values.
What is the simplest way to do this programmatically?
You need to go to the slide and use Application.CommandBars.ExecuteMso
If you don't need to return to the previously selected slide afterwards, you can skip DoEvents and the second call to Application.CommandBars.ExecuteMso
It seemed like the position of the new shape was sometimes a little bit skewed after pasting, so I obtain a reference to the last shape in the Shapes collection of the second slide and copy the position of the original shape.
At least on my machine, without DoEvents, the macro would do nothing when I executed it (but it would work if I stepped through it).
Sub CopySelectedShapeToNextSlide()
Dim oShape As Shape
Dim oSlide As Slide
Dim nextSlide As Slide
Dim newShape As Shape
Set oShape = Application.ActiveWindow.Selection.ShapeRange(1)
Set oSlide = Application.ActiveWindow.Selection.SlideRange(1)
Set nextSlide = oSlide.Parent.Slides(oSlide.SlideIndex + 1)
oShape.Copy
Application.ActiveWindow.View.GotoSlide nextSlide.SlideIndex
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Set newShape = nextSlide.Shapes(nextSlide.Shapes.Count)
newShape.Left = oShape.Left
newShape.Top = oShape.Top
DoEvents
Application.ActiveWindow.View.GotoSlide oSlide.SlideIndex
Debug.Print newShape.Name
End Sub
I have a simple question regarding PowerPoint VBA:
Which VBA code should I use to switch between the "active sheet of paper" (I am sorry I don't know how to name it properly), in which I am doing something with the object(s), and the file (or "field", again sorry for my poor terminology) where all the slides are ?
For example, if I want to move a selected object in the "active sheet of paper" I would use this macro:
ActiveWindow.Selection.ShapeRange.IncrementLeft
6#
and if I want to copy the selected slide in the slides file, I would use this code:
ActiveWindow.Selection.Copy
ActiveWindow.View.Paste
But how can I connect these two pieces of script? Let's say I want to move an object in the "active sheet of paper", then copy this whole "sheet", then create its twin in the slides field, and then jump into the twin sheet of paper to do something with objects there?
Shortly, how do I switch from "paper" to "slides" and back to "paper" in VBA?
(Again, I am sorry for terrible terminology here, I hope you understand what I mean here.)
Thank you all in advance.
If you record a macro in PowerPoint and examine the code, you'll see that it uses the Selection object for just about everything. That's sometimes useful (because it means it's more likely that the code will do what you want if you select another object), but for anything more than a very short macro, it's probably better to refer to the objects directly, as in the following code:
Sub Test()
' Get the active presentation
Dim oPresentation As Presentation
Set oPresentation = ActivePresentation
' Get the first slide in the presentation
Dim oSlide As Slide
Set oSlide = oPresentation.Slides(1)
' Get the first shape on the slide
Dim oShape As Shape
Set oShape = oSlide.Shapes(1)
' Nudge the shape to the right
oShape.Left = oShape.Left + 1
' Copy the whole slide
oSlide.Copy
' Paste the slide as a new slide at position 2
Dim oNewSlides As SlideRange
Set oNewSlides = oPresentation.Slides.Paste(2)
' Get a reference to the slide we pasted
Dim oNewSlide As Slide
Set oNewSlide = oNewSlides(1)
' Get the first shape on the NEW slide
Dim oNewShape As Shape
Set oNewShape = oNewSlide.Shapes(1)
' Nudge the shape to the right
oNewShape.Left = oNewShape.Left + 1
End Sub
Note that pretty much every object has a Select method, so if you do want to explicitly select something, you can. In some cases, you may need to change the active window's view type first - so for example, you can't select a shape on a slide while in slide-sorter view.