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
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 a shape (rectangle) created inside a canvas in Microsoft word 2013, with Left:=100
But when I read the left property of the shape, I get a number different from the one I have set in creation phase!
Sub DRTEXT()
Dim shp1 As Shape, shpCanvas As Shape
Set shpCanvas = ActiveDocument.Shapes.AddCanvas(Left:=0, Top:=0, Width:=400, Height:=400)
Set shp1 = shpCanvas.CanvasItems.AddShape(Type:=msoShapeRectangle, _
Left:=100, Top:=100, Width:=100, Height:=100)
MsgBox shp1.Left '(shows the number 5!)
shp1.Left = 200
MsgBox shp1.Left
End Sub
I feel this might be of the shape being inside a canvas which wont let me to move the shape as I want.
Any clues?
Many thanks
In vba(PowetPoint), I added animation effects to a shape object.
But any effects I set vanished without a sound effect if I added a sound effect.
The following is sample code.
I splittd their effects to one shape by one effect, the other shape by sound effect.
But I could not solve.
Sub hoge()
Const path As String ="./sound.wav"
Dim ppSld As PowerPoint.Slide
Dim shp As Shape
Set ppSld = ActivePresentation.Slides(1)
Set shp = ppSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 10, 10)
With ppSld.TimeLine.MainSequence.AddEffect( _
Shape:=shp _
, effectId:=msoAnimEffectFly)
effect.Timing.Duration = 10 'duration time
effect.EffectInformation.SoundEffect.ImportFromFile path 'sound
End With
End Sub
I wrote some code for a client which isn't working correctly on his machine (Win 10, Office 365) but is on mine (Win 10, Office 2016). The code inserts an image to the header then positions it and resizes it. I use the ConvertToShape method so I can access properties like width, height and position of the Shape class.
Dim pic As Shape
Dim shp As Word.InlineShape
Set shp = thisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(fpImage) ' insert the image to the header
Set pic = shp.ConvertToShape ' THIS LINE CAUSES THE PROBLEM
The method causes the image to disappear. 'Pic' is still available and setting it's properties causes no error, but it is not visible. It's .visible property returns true.
Any ideas? Thanks.
Answer provided to cross-post at Microsoft Community
There is a way to do this with only an inline shape, by setting up a table to position the text on the left and the picture on the right. An additional advantage of this method is that, if you set the table's AutoFitBehavior property to wdAutoFitFixed and set the column width to the width you want for the shape, Word will automatically resize the picture to that width and keep the aspect ratio.
Here's a little sample macro:
Sub x()
Dim fpImage As String
Dim strExistingHeaderText
Dim tbl As Table
Dim shp As InlineShape
fpImage = "D:\Pictures\bunnycakes.jpg"
With ActiveDocument
strExistingHeaderText = _
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text
Set tbl = .Tables.Add( _
Range:=.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
numrows:=1, numcolumns:=2, _
AutoFitBehavior:=wdAutoFitFixed)
tbl.Columns(2).Width = InchesToPoints(1.5)
tbl.Columns(1).Width = InchesToPoints(5#)
tbl.Cell(1, 1).Range.Text = strExistingHeaderText
'tbl.Borders.Enable = False
Set shp = tbl.Cell(1, 2).Range.InlineShapes.AddPicture(fpImage)
End With
End Sub
I trying to make PowerPoint load up images to replace placeholders everytime a slide changes.
I have the code working, which changes the placeholders with images from local drive or url. But it wont work on OnSlideShowPageChange() event(mentioned here). With no prior experience on VB/VBA, I have no idea why, as it does not give any errors. I know the event is accessed because if I put a MsgBox()-function in it, it is displayed.
ImageReplace code:
Dim strPicName As String
Dim shp As Shape
Dim sglShapeLeft As Single
Dim sglShapeTop As Single
Dim sglShapeHeight As Single
Dim sglShapeWidth As Single
'Get the name of the shape (image)
'Provided this is the only shape on the slide
'Since I don't think you can use the ME. keyword to reference an impage from Powerpoint VBA
'(Me.shape.Name)
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
'Select the Image
ActiveWindow.Selection.SlideRange.Shapes(strPicName).Select
'Get the Left and Top starting points and width and height
sglShapeLeft = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Left
sglShapeTop = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Top
sglShapeHeight = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Height
sglShapeWidth = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Width
'Delete the Image
ActiveWindow.Selection.ShapeRange.Delete
'Insert a new Image at the same starting points as the previous image
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=sglShapeLeft, Top:=sglShapeTop, Width:=sglShapeWidth, Height:=sglShapeHeight).Select
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
ActiveWindow.Selection.SlideRange.Shapes(strPicName).IncrementRotation 276#
Any help is appreciated
ActiveWindow is not accessible when in slide show view.
Try this instead
Dim sld As Slide
Set sld = ActivePresentation.Slides _
(ActivePresentation.SlideShowWindow.View _
.CurrentShowPosition)
Set shp = sld.Shapes(1)
With shp
sld.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).IncrementRotation 276#
.Delete
End With
BTW, debugging and exceptions do not seem to be supported in the OnSlideShowPageChange event. As an easy approach place a MsgBox after each line of code to see where the execution stops.