macro that create outline shape for picture

Can anyone help me create a macro that make outline shape 1/4 for all pictures in the ppt
I try using the record macro but that didnt work well on powerpoint 2013
I’m using ppt 2013 right now

It would probably help if you explain what you mean by "make outline shape 1/4"

But in the meantime try this

Set ONE picture how you want it and make sure it is selected then run

Code:

---

Sub setPicType()
On Error Resume Next
ActiveWindow.Selection.ShapeRange(1).PickUp
If Err <> 0 Then Exit Sub
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If IsPic(oshp) Then oshp.Apply
Next
Next
End Sub


Function IsPic(oshp As Shape) As Boolean
If oshp.Type = msoPicture Then IsPic = True
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then IsPic = True
End If
End Function

---

Quote:

---

Originally Posted by John Wilson

It would probably help if you explain what you mean by "make outline shape 1/4"

But in the meantime try this

Set ONE picture how you want it and make sure it is selected then run

Code:

---

Sub setPicType()
On Error Resume Next
ActiveWindow.Selection.ShapeRange(1).PickUp
If Err <> 0 Then Exit Sub
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If IsPic(oshp) Then oshp.Apply
Next
Next
End Sub


Function IsPic(oshp As Shape) As Boolean
If oshp.Type = msoPicture Then IsPic = True
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then IsPic = True
End If
End Function

---

---

thank you i will try this
1/4 mean the weight of the outline

Or you could try NOTE This is a 1/4/ POINT border if you want 1/4 inch the weight value would be 18

Code:

---

Sub setPicType()
On Error Resume Next
If Err <> 0 Then Exit Sub
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If IsPic(oshp) Then
' Grey adjust values to suit
oshp.Line.ForeColor.RGB = RGB(200, 200, 200)
oshp.Line.Weight = 0.25
End If
Next
Next
End Sub




Function IsPic(oshp As Shape) As Boolean
If oshp.Type = msoPicture Then IsPic = True
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then IsPic = True
End If
End Function

---