I need to get image ScaleWidth scaling factor and set ScaleHeight the same.
How do I get the image's height or width scaling factor?
Normally code such as this would scale with lock aspect ratio, but every time I produce a handout in PowerPoint I get very small images.
I use a macro to resize the picture, but these handout generated images do not scale with "lock aspect ratio" even if I use .LockAspectRatio = msoTrue.
I want to scale the height myself.
After I scale the width to 18.46 cm, I want to get the ScaleWidth, and set the ScaleHeight to the same number.
Ex. If ScaleWidth ends up being 145 %, then get this number and set ScaleHeight the same.
I am not able to find a solution to get ScaleHeigth, and the guide to get Height pixel/inches is not something I am able to execute in my doc.
Sub Resize_All_Images()
'
' Resize all pictures to that corresponding size
'
'
With ActiveDocument
For I = 1 To .InlineShapes.Count
With .InlineShapes(I)
'the width that it will resize to'
.Width = CentimetersToPoints(18.46)
End With
Next I
End With
End Sub
Try this:
Sub Resize_All_Images()
'
' Resize all pictures to that corresponding size
'
'
Dim NewWidth As Long: NewWidth = CentimetersToPoints(18.46)
Dim ils As InlineShape
With ActiveDocument
For Each ils In .InlineShapes
With ils
'the width that it will resize to'
.Height = (.Height / .Width) * NewWidth
.Width = NewWidth
.LockAspectRatio = msoTrue
End With
Next ils
End With
End Sub
Related
i want to crop all images in my Word-document to a circle shape.
My current VBA is not doing anything. I am not quite sure how to do this. I found some VBA examples but not for Word (Power-Point)
My VBA at the moment is looking like this:
After looking more into it it seems my proble is that the images are inlineshapes?
Is there still any possible solution?
Sub Circles()
Dim allShapes As ShapeRange
Dim myShape As Shape
Set allShapes = Selection.ShapeRange
For Each myShape In allShapes
With myShape
.AutoShapeType = msoShapeOval
.Height = InchesToPoints(0.18)
.Width = InchesToPoints(0.18)
End With
Next myShape
End Sub
Cropping a picture to a circle is actually filling a shapes background with a picture.
Here is the code for doing that:
ActiveDocument.Shapes.AddShape msoShapeOval, 100, 100, 100, 100
ActiveDocument.Shapes(1).Fill.UserPicture ("Y:\Pictures\Mk45 Gun Proj_Blast.jpg")
The result:
I have the following code:
Sub StandardiseChart(ByVal control As IRibbonControl)
Dim activeShape As Shape
'Determine Which Shape is Active
If ActiveWindow.Selection.Type = ppSelectionShapes Then
'Loop in case multiples shapes selected
Dim shp As Shape
For Each shp In ActiveWindow.Selection.ShapeRange
Set activeShape = shp ' First shape selected
Exit For
Next
'Now, reformat the selected shape if it is a chart
With activeShape
If .HasChart Then
' Chart title
.Chart.HasTitle = True
With .Chart.ChartTitle
.Left = 0
.Top = 0
End With
' Y axis
With .Chart.Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Text = "Placeholder"
.AxisTitle.Left = 0
.AxisTitle.Top = 20
.AxisTitle.Orientation = 0
End With
' Plot Area
With .Chart.PlotArea
.Left = 10
.Top = 50
End With
End If
End With ' activeShape
End If
End Sub
What I'd like it to do is 3 things:
Pin the Chart Title to the top left corner of the entire object (this seems fine)
Set the y-axis title so that there is 20pt of space between it and the chart title (also seems fine)
Create a further 50pt of space between the plot area and the y-axis title (not fine).
No matter what I do (I've tried adjusting the number to 70 rather than 50, and even bigger), I can't seem to adjust the space to achieve (3). Specifically, the plot area doesn't move no matter what I do.
What am I doing wrong?
If you add a dot to the end of Chart.Plotarea, you can see the list of methods. In your case, you're looking for .InsideLeft and .InsideTop, since you want to adjust the inside distance from the chart area:
With .Chart.PlotArea
.InsideLeft = 70
.InsideTop = 70
End With
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 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
I have been working on a small hack around with Power Point to automatically create a Text Box Shape with some preset effect in which the text is dynamically fetched from clipboard. I have quiet a bit of a problem here, the functionality works fine with the following VB script with macros.
Sub ReadFromFile()
' CLIPBOARD
Dim MyData As DataObject
Dim strClip As String
' CLIPBOARD
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
Set activeDocument = ActivePresentation.Slides(1)
With activeDocument
'Set QASlide = .Slides.Add(Index:=.Slides.Count + 0, Layout:=ppLayoutBlank)
activeDocument.Shapes.AddTextEffect PresetTextEffect:=msoTextEffect28, _
Text:=strClip, _
FontName:="Garde Gothic", FontSize:=44, FontBold:=msoTrue, _
FontItalic:=msoFalse, Left:=25, Top:=25
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
End With
End Sub
Can some one help me in providing the script for wrapping the text inside the shape which has a defined width and height as in the code above?
Not sure if I understand you right but does adding .TextFrame.WordWrap = msoTrue to the block below solve your problem?
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
I think you are looking for this:
.Shapes(.Shapes.Count).TextFrame.TextRange.Text = strClip
You can set it in the same With that you are setting the height and width
If you want text to wrap within a shape, you'll have to use something other than a texteffect shape.