macro that create outline shape for picture

[mrmb97]

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

[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


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

[mrmb97]

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


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

[John Wilson]

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


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