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:
Related
I am trying to write VBA code that can reproduce the following shape:
I wrote a piece of code that can create the shape:
Sub InsertShape()
Set myDocument = ActivePresentation.Slides(1)
myDocument.Shapes.AddShape Type:=msoShapeChevron, _
Left:=50, Top:=50, Width:=100, Height:=200
End Sub
However now I am looking for a way so I can adjust the width and height and move it to specific position. If I click on the shape (see highlighted areas) I see the target shape has the following values:
Height: 6:51
With: 7,07
Horizontal position: 11,16
Vertical position: 4,52
Any feedback on what I should add to the code so the shape is in the right position (+ correct width an height).
Use the .Height/.Width/.Left/.Top parameters to adjust the size and position of the shape (note that the values are in points; 28.35 points/cm or 72 points/inch).
Use the shape's .Adjustments(1) property to modify the characteristics of the shape. Start with a value of approximately .2 to get the kind of shape you're after.
Sub InsertShape()
' ALWAYS Dim your variables
Dim myDocument as Slide
Dim oSh as Shape
Set myDocument = ActivePresentation.Slides(1)
Set oSh = myDocument.Shapes.AddShape Type:=msoShapeChevron, _
Left:=50, Top:=50, Width:=100, Height:=200
With oSh
.Adjustments(1) = .2
' Change other shape properties here too if you wish
End With
End Sub
I am trying to change the text color of the chart title of a histogram chart in PowerPoint.
Here is what I do:
var colorFormat = chart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor;
colorFormat.RGB = ...;
// or
colorFormat.ObjectThemeColor = ...;
This works for the standard charts like line charts. But it doesn't work for other chart types like histogram, waterfall, tree map etc.
In these cases, setting ObjectThemeColor sets the text to black. Setting RGB does actually set the correct color. However, in both cases, as soon as the user changes the selection, the text color jumps back to the one it had previously.
How can I set the text color of the title of one of these charts?
I am using VSTO and C# but a VBA solution is just as welcome as long as it can be translated to C# and still work.
Based on what info you gave I built a histogram and waterfall chart in PowerPoint and was successful using:
Sub ChartTitleFontColor()
Dim oShp As Shape
Dim oCht As Chart
'Waterfall on slide 1
Set oShp = ActivePresentation.Slides(1).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then
Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
'Histogram on slide 2
Set oShp = ActivePresentation.Slides(2).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
Your code works in my test. I created two charts in PowerPoint 2016, the first one a waterfall, and the second another type. The following code changes the title color only (and text just a proof of it being changed) and nothing else. I can select the other chart and nothing changes. I could not find a bug about this in a search. Perhaps something in the remaining code is changing it back?
Sub test()
Dim myPresentation As Presentation
Set myPresentation = ActivePresentation
Dim myShape As Shape
Set myShape = myPresentation.Slides(1).Shapes(1)
Dim theChart As Chart
If myShape.HasChart Then
Set theChart = myShape.Chart
If theChart.ChartTitle.Text = "This is blue" Then
theChart.ChartTitle.Text = "This is yellow"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 0)
Else
theChart.ChartTitle.Text = "This is blue"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
End If
End If
End Sub
This is not exactly an answer but I think you should name your object.
Instead of using
ActivePresentation.Slides(1).Shapes(1)
You can name the object.
I'm updating my MS PowerPoint by pasting images on different slides using VBA.
Rest of the code is working fine. What I'm unable to do is delete the existing image on all the slides and paste the new image. Currently it paste the new image on top of old image, but old image remains. I'm using below code:
Dim pptApp As PowerPoint.Application
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
xlApp.Worksheets(2).Range("M2:S12").Copy
Set shp1 = ActivePresentation.Slides(17).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)
With shp1
.Left = 370
.Top = 100
.Height = 360
.Width = 340
End With
Being a newbie to VBA, I dont know where and how to add delete command in above code. Any kind of help would be appreciated.
This (thanks, L42) will work for single msoPicture shapes on a slide, but if there's more than one shape, it may miss some:
Dim s As Shape
For Each s In ActivePresentation.Slides(17).Shapes
If s.Type = 13 Then s.Delete '13 is msoPicture
Next
Why? Suppose you have three shapes on the slide. We iterate through the shapes collection, find that the first shape is a picture and delete it. Now there are two shapes in the shapes collection, but VBA's counter doesn't take account of changes in the collection count. It looks at the second shape in the collection, but that's now what WAS the third shape on the slide, so the code will miss shape #2 altogether.
It's more reliable to use something like this:
Dim x as Long
For x = ActivePresentation.Slides(17).Shapes.Count to 1 Step -1
If ActivePresentation.Slides(17).Shapes(x).Type = msoPicture Then
ActivePresentation.Slides(17).Shapes(x).Delete
End If
Next
Edit1: As what Steve pointed out, the first posted solution is unreliable; also as confirmed in this POST by Doug.
To delete all pictures using loop, take Steve's approach as explained in his post.
Now, if you just want to delete all the pictures, you can try this:
ActivePresentation.Slides(17).Shapes.Range.Delete
But this deletes all shapes, not only pictures but textboxes, lines, shapes etc.
To delete only pictures, below is another approach using loop.
Dim s As Shape, pictodel As Variant
For Each s In ActivePresentation.Slides(17).Shapes
If s.Type = 13 Then
If IsArray(pictodel) Then
ReDim Preserve pictodel(UBound(pictodel) + 1)
pictodel(UBound(pictodel)) = s.Name
Else
pictodel = Array(s.Name)
End If
End If
Next
ActivePresentation.Slides(17).Shapes.Range(pictodel).Delete
Hope this helps but a simpler solution would be Steve's. :)
I am programatically copying tables and graphs from Excel to PowerPoint.
Ideally, I'd like to center the graphs on the slide and resize them to fit the slide if necessary.
This shouldn't be too hard, and I can check & modify .Top, .Left, .Width, .Height of the shape just fine, but how do I find out the width/height of the slide itself to do the proper positioning?
The following will give you the Height and Width ...
Just divide by 2 :D
Sub a()
Dim a As Presentation
Set a = ActivePresentation
MsgBox a.PageSetup.SlideHeight, a.PageSetup.SlideWidth
End Sub
HTH
I found a VBA macro online that resizes all the images in a Word document:
Sub ResizeAllImages()
''# make all images (both inline and floating)
''# 11 cm wide while preserving aspect ratio
Dim oShp As Shape
Dim oILShp As InlineShape
For Each oShp In ActiveDocument.Shapes
With oShp
.Height = AspectHt(.Width, .Height, _
CentimetersToPoints(11))
.Width = CentimetersToPoints(11)
End With
Next
For Each oILShp In ActiveDocument.InlineShapes
With oILShp
.Height = AspectHt(.Width, .Height, _
CentimetersToPoints(11))
.Width = CentimetersToPoints(11)
End With
Next
End Sub
I couldn't find the name of a method that I could use to center-align all images.
Does anyone know what I need to add, and where I would have to add it?
Lastly, I'd like to delete images that I find to be too small.
How would I do... If width of shape is smaller than 5, and height of shape is smaller than 5, delete the shape.
For easier reading of large amounts of online text, I sometimes like to paste everything in word, and then rearrange it.
I replace every period-whitespace, with a period-manual line, which gives me a new line for each sentence.. I read better when it's like that. Since I'm pasting everything, the graphics comes too, so I'd like to be able to control the size of all the images, and get rid of any unnecessary images.
I think you cannot center-align images. You can center-align paragraphs. Perhaps something like this will help you:
For Each oILShp In ActiveDocument.InlineShapes
oILShp.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next
For deletion, just call Delete for each Shape object satisfying your conditions.
http://yuriy-okhmat.blogspot.co.uk/2011/07/how-to-resize-all-images-in-word.html
Has the full code including definition of AspectHt
Code to delete small pictures:
Sub DeleteSmallPictures()
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Width < CentimetersToPoints(5) Then
iShp.Delete
End If
End With
Next iShp
End Sub