Create powerpoint shape with vba - vba

I am trying to create a VBA that creates a green up arrow with no border. Currently the VBA is creating a green arrow with a black border. Can anyone help me out with this? My code is below. I tried shp.Line.Fill.ForeColor.RGB = RGB(137, 143, 75)and was still getting the black outline.
Thanks in advance.
Sub Up_Arrow()
Dim i As Integer
Dim shp As Shape
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
Set shp = sld.Shapes.AddShape(35, 10, 10, 5.0399, 8.6399)
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
Update: Probably not the most sophisticated way to do it but following line of code worked.
shp.Line.ForeColor.RGB = RGB(137, 143, 75)

shp.Line.Visible = msoFalse
is what you need.
In fact, you can obtain the code required by recording a macro :)

You can make the line invisible this way:
shp.Line.Visible = MsoFalse

Related

VBA for Word, crop image to circle

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:

How to create ActiveX TextBox dynamically on PowerPoint

I am a free-lance Java programmer who, for the first time, is asked to do some VBA programming on PowerPoint and I am struggling a bit.
I have created a button, which triggers the creation of a slide (this works).
On this new slide, I want to create an ActiveX TextBox (one of those that work when in Presentation mode), but I am only able to create "stardard" PowerPoint textboxes.
I am sure this is a quite easy command, but I cannot find it anywhere..
This is the code that I am using. Can somebody help me?
Thank you!
Public Sub addContentToSatelliteSlide()
currentSlide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
'CURRENT SLIDE ON SLIDESHOW
With ActivePresentation.Slides(currentSlide + 1).Shapes
With .AddTextbox(msoTextOrientationHorizontal, 160, 80, 400, 400).TextFrame
.TextRange.Text = "add informatiom here"
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
.TextRange.Font.Color = RGB(255, 255, 255)
.TextRange.Font.Size = 11
.TextRange.Font.Name = "Arial"
.TextRange.Font.Bold = False
.TextRange.Font.Color = RGB(0, 0, 0) 'BLACK
End With
End With
End Sub
An ActiveX text box is an OLE control, so use this syntax instead:
.AddOLEObject Left:=160, Top:=80, Width:=400, Height:=400, ClassName:="Forms.TextBox.1"
Here's the Microsoft help page for this: Shapes.AddOLEObject method (PowerPoint)

Create add-in to add sticky notes in powerpoint (VBA)

I would like to create a simple macro for powerpoint that would allow me to click on one button to automatically insert a yellow sticky note onto my slide so I can insert a comment. This is something I need to do over and over in my current job and right now I am wasting a lot of time, each time creating a rectangle -> coloring it yellow -> creating a black outline -> setting font color to red and size to 12..
Appreciate any help here, I know it should not be very hard!
Thanks!
example of standard stickynote on a slide (at scale)
I wrote this for you and hope it helps.
Sub insert_sticky_note()
Dim mySlide As PowerPoint.Slide
Dim myTextbox As PowerPoint.Shape
Set mySlide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
Set myTextbox = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=10, Width:=200, Height:=50)
myTextbox.Fill.BackColor.RGB = RGB(250, 246, 0) 'yellow
myTextbox.Fill.Transparency = 0.2 'translucent
myTextbox.Height = 150
myTextbox.Width = 300
myTextbox.TextFrame2.AutoSize = msoAutoSizeTextToFitShape 'https://www.pcreview.co.uk/threads/how-to-vba-code-shrink-text-on-overflow.3537036/#post-12183384
With myTextbox.TextFrame.TextRange
.Text = "Note"
'With .Font
' .Size = 12
' .Name = "Arial"
'End With
End With
End Sub

PowerPoint VBA: "No currently active document window"

I am trying to create a shape on a slide in PowerPoint (2010) VBA
I have created a button and this code:
Private Sub AddShape_Click()
Dim shp As Shape
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=24, Top:=65.6, Width:=672, Height:=26.6)
'No Shape Border
shp.Line.Visible = msoFalse
'Shape Fill Color
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
When I run the presentation as a slide show and click the Add Shape button, I get the following error:
Run-time error '-2147188160 (80048240)':
Application (unknown member): Invalid request. There is no currently active document window.
Everything I have found online indicates that this code should run OK.
All assistance appreciated!!!
Carolyn
You will get the No Current Active Document Window error if you run your code while the presentation is in Slideshow (fullscreen) mode. Try this, instead:
set sld = Application.ActivePresentation.SlideShowWindow.View.Slide
Things work differently in slide show view, but a couple very simple modifications will get this fixed up. Add this to the project and assign the AddShape_Click as an Action Setting (Run Macro):
Public Sub AddShape_Click(oBtn As Shape)
' It has to be public for the action setting to see it
Dim shp As Shape
Dim sld As Slide
'Set sld = Application.ActiveWindow.View.Slide
Set sld = oBtn.Parent
Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=24, Top:=65.6, Width:=672, Height:=26.6)
'No Shape Border
shp.Line.Visible = msoFalse
'Shape Fill Color
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
You can also get this error if PowerPoint recently crashed and is still running in the background. Try killing any such powerpoint processes using task manager and then try again.

vba hyperlinks and shape creation

I have a subroutine that will create a shape, but I have two problems with the code:
I must specify on which slide this shape will be created. This is a problem if I want to create the same shape on multiple slides simultaneously. How do I achieve that? what do I replace activepresentation.slides(x) with?
I want the shape to have a hyperlink to a specific slide. What is wrong with my code to achieve that? It gives me an error when I try to assign an action to the shape I have created.
Sub createshape()
Dim oshp As Shape
Dim osld As Slide
'old code
Set osld = ActivePresentation.Slides(1)
Set oshp = osld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
oshp.ActionSettings (ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 1 'this should take the hyperlink to slide 1 i hope.
End Sub
I want to automate this function because I will be doing this same thing for many many slides multiple times.
Something like this will act on the current slide. I tested for a slide 2 hyperlink to esnure that the code worked (and didn't use 1 as default)
Sub CreateShape()
Dim oShp As Shape
Dim oSld As Slide
Set oSld = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
Set oShp = oSld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
With oShp.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
'.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 2
End With
End Sub