I looked around. All I was able to find was resizing in Excel or through Excel.
I am pasting a picture from pdf and need one click resizing and positioning.
I finally got it .. Here is what I did, just in case someone is facing same problem.
This re-sizes the image, sets it in the desired position and sends it to the back.
Sub Resize()
With ActiveWindow.Selection.ShapeRange
.Height = 2.78 * 72 //72 is the multiplier for the inch
.Width = 4.17 * 72
.Left = 0.78 * 72
.Top = 1.25 * 72
.ZOrder msoSendToBack // This sends picture to the back
End With
End Sub
Thanks for the code. I wanted to be able to automatically resize a bunch of screenshots to fit the size of a slide. I'm guessing other people might need to do this too, so I'm posting what I did.
First, in PowerPoint 2010 in Page Setup, I set the slides to be 16:9 to match the proportions of my monitor/screenshots. Then I added a blank slide and pasted the image for each screenshot. I then ran this code:
Sub ResizeAll()
For each tSlide in ActiveWindow.Presentation.Slides
tSlide.Select
With tSlide.Shapes.Item(1) 'assume a blank slide with one image added only
.Select
.Height = ActiveWindow.Presentation.PageSetup.SlideHeight
.Width = ActiveWindow.Presentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With
Next
End Sub
code to fit an image in a slide (change the height and width as per requirement) :
pptSlide.Shapes(1).Height = 850: pptSlide.Shapes(1).Width = 650
Related
I'm working on an MS Word function to simplify floating image layout.
Consider the case where there's a normal, single column, page of text and the image floats on the right. When we want the image just below the paragraph, that's 'easy' (error handling removed):
Dim myShape As Shape
Set myShape = Selection.ShapeRange(1)
With myShape
.WrapFormat.Type = wdWrapSquare
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = 0
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeRight
End With
That's usually all that's needed. But when the anchor is near the end of a page and that would make the image go below the bottom of the page, that can cause an ugly blank space at the bottom of the page:
I want to avoid moving the anchor. Instead, it's often enough to put the image just above the anchor instead of just below it. But I cannot work out how to do that in code. In this example, the image height is 2". But if I set the 'relative vertical position' to -2", the image floats about half an inch too high:
To what value should I set the relative vertical position for the image to float just above the anchor?
P.s. the rules are in http://www.tug.org/TUGboat/tb35-3/tb111mitt-float.pdf and the first step is images in textboxes https://www.securedevelopment.org/2019/08/18/three-powerful-techniques-to-position-images-and-tables-in-word/ . If there's interest I'll open source the functions and examples.
Many thanks, #yokki. This is what I've come up with. It seems fast enough. It assumes that the para spacing is consistent and that the shape is not near the top of the page. Note: this is not a complete answer, as the image doesn't move with the paragraph afterwards.
Dim myShape As Shape
Set myShape = Selection.ShapeRange(1)
With myShape
.WrapFormat.Type = wdWrapSquare
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeRight
Set AnchorParagraph = .Anchor.Paragraphs(1)
ParaSpacing = AnchorParagraph.SpaceAfter
Set AnchorParagraph = .Anchor.Paragraphs(1)
ParaSpacing = AnchorParagraph.SpaceAfter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = AnchorParagraph.Range.Information(wdVerticalPositionRelativeToPage) - .Height - ParaSpacing
Do Until .Top + .Height + 1 + ParaSpacing > AnchorParagraph.Range.Information(wdVerticalPositionRelativeToPage)
.IncrementTop (1)
Loop
End With
To get proper floating, I've found another solution: to use vertical positioning centered relative to line.
I have many powerpoint files which have a picture at the top-right corner on every single slide. It is neither a master slide, NOT a custom layout shape.
They were pasted one by one to all slides.
I have some codes as below to remove all shapes(pictures) from slides, but how to locate the shapes(pictures) at a specific location of a slide?
For Each Slide In SlideList
Set sldTemp = ActivePresentation.Slides(Slide)
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
'----------Delete All shapes = picture----------
If .Type = msoPicture Then
.Delete
End If
End With
Next
Next
'-----------------------------------------
I am not very good at VBA for powerpoint coding, any suggestion is appreciated.
thank you.
You can check the position by looking at the Top and Left properties. You could also check the size if they're all the same size.
Eg:
If .Type = msoPicture Then
If .Top > x and .Top < y and .Left > a and .Left < b Then
.Delete
Exit For
End If
End If
Where x,y, a and b are variables or hard-coded values.
thanks to Tim Williams very much.
The pilot codes run correctly on 3 Win10 x86 computers.
by the way, according to this saying
By default, the size of the new presentation in PowerPoint, is currently a widescreen type presentation, 13.333 inch by 7.5 inch. Mostly you will have 96 dots per inch (dpi) on your screen settings, so this means that a default PowerPoint presentation has a resolution of 1280 by 720 pixels.
though the top-left values set below can match exactly the top-right small logo(shape) in my powerpoint slide, and the same results from 3 different display ,and one of which is in low definition mode.
Sub DeleteAllTopRightShapes()
Dim sldTemp As Slide
Dim lngTemp As Long
Dim lngCount As Long
For Each sldTemp In ActivePresentation.Slides
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
If .Type = msoPicture Then
If .Top >= 0 And .Top < 60 And .Left >= 400 Then
.Delete
End If
End If
End With
Next
Next
MsgBox "Process complete!"
End Sub
I have a sheet in excel that list products and a picture for each product (Column D). I have put the following code in the worksheet but my problem is this.
Problem: If a user clicks on a product image and then clicks on another image before clicking on a 2nd time to make the image small again the 2nd clicked image disappears and the 1st image adjusted to the new size and will only enlarge even bigger.
Image:
Screenshot Steps of what is happening
Option Explicit
Dim fd As Boolean
Sub PicPopUp_Click()
fd = fd Xor True
With ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
If fd Then
.Left = .Left - 50
.Width = .Width + 50
.Top = .Top - 50
.Height = .Height + 50
Else
.Left = .Left + 50
.Width = .Width - 50
.Top = .Top + 50
.Height = .Height - 50
End If
.ShapeRange.ZOrder msoBringToFront
End With
End Sub
I'm not familair enough with your code.. But would it be possible to reset column D on every click on that column? I'm assuming that all the images are a standard size.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
MsgBox "Nice Work!" 'place reset image size code here.
Call "whatever your image resize macro is named"
End If
End Sub
I have created a Gantt chart that sits directly next to the row the data is pulled from so everything is in one neat line. There are several months of data, so I have created two buttons (Next Page/Previous Page) that add/subtract 30 from the minimum and maximum values of the x-axis. Because everything is lined up Gantt-table-style, I have been trying to reset the chart's location to it's original one. Unfortunately, the chart still moves creating a small gap between the chart and my data. Any advice is greatly appreciated!
None of my charts corners lay on the corner of a cell, plus some columns may be re sized later on.
Private Sub NEXT_PG_Click()
Dim chart_height As Single, chart_length As Single, chart_top As Single, chart_left As Single
'Saving original position to save later
With ActiveSheet.ChartObjects("Chart 2")
chart_height = .Height
chart_width = .Width
chart_top = .Top
chart_left = .Left
End With
'Displaying next 30 days of data
With ActiveSheet.ChartObjects("Chart 2").Chart.Axes(xlValue)
.MinimumScale = .MinimumScale + 30
.MaximumScale = .MaximumScale + 30
End With
'Trying to set original location and size
With ActiveSheet.ChartObjects("Chart 2")
.Height = chart_height
.Width = chart_width
.Left = chart_left
.Top = chart_top
End With
End Sub
Added images
Update: As a temporary fix, I have tried to set the location of the plot area to a specific location, but this makes it worse. Please see the change to the attempted with statement below:
With ActiveSheet.ChartObjects("Chart 2").Chart.PlotArea
.Height = Range("A8:A30").Height
.Width = Range("J6:U6").Width
.Top = Range("J8").Top
.Left = Range("J8").Left
End With
How can I position and/or change the size of the slides on fullscreen slideshow presentation? (While running the slideshow)
With ActivePresentation.SlideShowSettings.Run()
.Left = 277
.Top = 128
.Width = 380
.Height = 290
End With
Didn't find a way to avoid "flashing" of first slide.