I wish a simple VBA macro that inserts a picture then changes its height and width. It works first time run. The user, however, can add multiple pictures by running the macro more than once and my problem is that the macro inserts the next image but then resizes an image already on the document rather than the one just inserted. I would have assumed that the .count would return the last image (i.e. the one jsut inserted) It appears that the 'Set myImage line' doesn't reference the just inserted image.
Any help welcome. Code below.
Greg
ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, FileName:= _
"c:\mydir\carp3d.tif", LinkToFile:=False, SaveWithDocument:=True
' get last inserted image
Set myImage = ActiveDocument.Shapes(ActiveDocument.Shapes.Count)
myImage.Select
myImage.LockAspectRatio = msoTrue
myImage.LockAspectRatio = msoTrue
myImage.Height = 180#
myImage.Width = 124.55
Shapes.AddPicture returns a Shape object that you should capture:
Set myImage = ActiveDocument.Shapes.AddPicture(....)
myImage.LockAspectRatio = msoTrue
' and so on
Related
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
I am using the Fill.UserPicture property to change the image displayed in a shape but the image doesn't get redrawn/refreshed. If I manually right-click the shape and do Change Picture and then paste in the same path and file name (copied from the VBA) it works.
this SO page says that it worked for them
Any reason why this might be?
I have tried making the Fill not visible first. I'm using Excel 2016.
EDIT: Added the code
Dim shpImage As Shape
Dim sNewImagePathAndName As String
sNewImagePathAndName = GetImageFromWebsite(sLineNumber)
Set shpImage = ThisWorkbook.Worksheets("Images").Shapes("shpTemplateImage")
With shpImage
If sNewImagePathAndName <> vbNullString Then
.Fill.Visible = msoFalse
.Fill.UserPicture PictureFile:=sNewImagePathAndName
Debug.Print sNewImagePathAndName
.Fill.Visible = msoTrue
End If
End With
Example of sNewImagePathAndName: "H:\My Documents\Project One\Development\Visual Stock Pack\TS03N50NBLK_Large_F_1.jpg"
I am writing a macro to insert a textbox containing a pre-formatted table into a Microsoft Word document, and I want it to insert the table at the current cursor location. With the current code I have, the textbox seems to be inserted at the beginning or end of the current page, instead of the cursor location.
Here is my code:
Sub InsertTable()
Dim shpTbox As Shape
Dim rngTbox As Range
Dim tblBox As Table
Set shpTbox = ActiveDocument.Shapes.addtextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=72, Top:=50, Width:=468, Height:=220, Anchor:=Selection.Range)
shpTbox.TextFrame.TextRange.Tables.Add Range:=shpTbox.TextFrame.TextRange, NumRows:=8, NumColumns:=4, _
DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
shpTbox.TextFrame.TextRange.Tables.Item(1).Select
shpTbox.TextFrame.TextRange.Tables(1).Style = ActiveDocument.Styles("Custom Table")
Selection.InsertCaption Label:="Figure", _
Title:=". Insert Caption Here", _
Position:=wdCaptionPositionBelow
shpTbox.Line.Visible = msoFalse
shpTbox.WrapFormat.Type = wdWrapSquare
shpTbox.WrapFormat.Side = wdWrapBoth
shpTbox.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
Is there a way to do what I want to do? Can someone explain why this doesn't do what I want it to do?
Thank you!
Word positions to the page by default. You need to tell it otherwise, and re-set the Left and Top properties afterwards. After the TextBox has been inserted specify the relative horizontal and vertical positions. For example:
shpTbox.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
shpTbox.RelativeVerticalPosition = wdRelativeVerticalPositionLine
shpTbox.Left = 72
shpTbox.Top = 50
You may want to test some of the WdRelativeHorizontalPosition and WdRelativeVerticalPostition enumeration values to see what works best for your situation.
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