Adding a formatted rectangle on selected slide

Hello Friends,

I have been trying to place a formatted rectange on some specific slide, but I have to use the below two set of code 1) to insert shape, 2) to format shape. Can these two set of codes be merged into one.

Also this code inserts the shape only on the first slide irrespective of which ever slide I am on. Please can someone help me with a code snippet which places the shape on any specific slide we select.

1)
Sub insert_shape()
Set myDocument = ActivePresentation.Slides(1)
myDocument.Shapes.AddShape Type:=msoShapeRectangle, Left:=350, Top:=460, Width:=360, Height:=50
End Sub

2)
Sub White_Fill()
With ActiveWindow.Selection.ShapeRange
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.BackColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0#
.Fill.TwoColorGradient msoGradientHorizontal, 1
.Line.Visible = msoFalse
End With
End Sub

Thanks,
Rafael

There's no point setting a gradient if both colors are the same
Transparency defaults to 0 so that is not needed

I have change the RGB for the forecolor so yo can see it works.

You need to say which version and whether it is running in show mode or edit (The code below is for edit only - for show change Set osld = ActiveWindow.Selection.SlideRange(1) TO
Set osld=SlideShowWindows(1).View.Slide

Sub Add_Format()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.Selection.SlideRange(1)
If Err <> 0 Then
MsgBox "Select a slide"
Exit Sub
End If
Set oshp = osld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=350, Top:=460, Width:=360, Height:=50)
With oshp
.Fill.ForeColor.RGB = RGB(255, 255, 111)
.Fill.BackColor.RGB = RGB(255, 255, 255)
.Fill.TwoColorGradient msoGradientHorizontal, 1 'this does nothing if fore and backcolor are the same
.Line.Visible = msoFalse
End With
End Sub

This is Awesome!

Thank you so much John, this code works perfectly as I wanted.

Quote:

---

Originally Posted by John Wilson

There's no point setting a gradient if both colors are the same
Transparency defaults to 0 so that is not needed

I have change the RGB for the forecolor so yo can see it works.

You need to say which version and whether it is running in show mode or edit (The code below is for edit only - for show change Set osld = ActiveWindow.Selection.SlideRange(1) TO
Set osld=SlideShowWindows(1).View.Slide

Sub Add_Format()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.Selection.SlideRange(1)
If Err <> 0 Then
MsgBox "Select a slide"
Exit Sub
End If
Set oshp = osld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=350, Top:=460, Width:=360, Height:=50)
With oshp
.Fill.ForeColor.RGB = RGB(255, 255, 111)
.Fill.BackColor.RGB = RGB(255, 255, 255)
.Fill.TwoColorGradient msoGradientHorizontal, 1 'this does nothing if fore and backcolor are the same
.Line.Visible = msoFalse
End With
End Sub

---

Hello John, I'm using PPT 2010 and I wanted the autosize feature to be off, but the code i used below doesn't seem to work. Please can you let me know if there is anything more that i need to add to this code.

Sub Add_Format()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.Selection.SlideRange(1)
If Err <> 0 Then
MsgBox "Select a slide"
Exit Sub
End If
Set oshp = osld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=350, Top:=460, Width:=360, Height:=50)
With oshp
.Fill.ForeColor.RGB = RGB(255, 255, 111)
.Fill.BackColor.RGB = RGB(255, 255, 255)
.Line.Visible = msoFalse
.LockAspectRatio = msoFalse
End With
End Sub

What does "AutoSize feature OFF" mean? Shapes don't have an AutoSize feature. Maybe you mean text in the shape?

How would you do this manually?

Yes John, the textbox property of the autoshape has to be set to "Do Not Autofit", but i'm not able to get the right code for it. I used this piece of code (.LockAspectRatio = msoFalse) to check if that worked, but it did not work.

I got the solution finally, I replaced (.LockAspectRatio = msoFalse) with (.TextFrame2.AutoSize = msoAutoSizeNone) and its working fine now, thanks

Saved me posting. You should use TextFrame2 to get the new fit options.