VBA Powerpoint to switch selected arrow directions on slide

[rumj]

We completed some designs showing paths in PowerPoint. Each design was about 20 slides long, and each slide had up to 10 pictures with paths drawn as PowerPoint arrows of different lines. For some hitherto unfathomable reason, someone decided that the paths needed to have the arrows pointing the other way. I came up with a macro (which looked bulky but worked) to do that. A more useful variation, which switches around selected arrows on the active slide is given below. Comments for improvement welcome



Sub ChangeSelectedArrowDirection()
'PURPOSE: change direction of selected arrows
'Rumey Jiffrey 2018


Dim sld As Slide
Dim shp As Shape


For Each shp In ActiveWindow.Selection.ShapeRange

Select Case shp.Type
Case MsoShapeType.msoFreeform
With shp.Line
If .BeginArrowheadStyle = msoArrowheadNone Then
If .EndArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadNone
End If
ElseIf .EndArrowheadStyle = msoArrowheadNone Then
If .BeginArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadLong
End If
End If
End With

Case MsoShapeType.msoAutoShape
With shp.Line
If .BeginArrowheadStyle = msoArrowheadNone Then
If .EndArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadNone
End If
ElseIf .EndArrowheadStyle = msoArrowheadNone Then
If .BeginArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadLong
End If
End If
End With

Case MsoShapeType.msoLine
With shp.Line
If .BeginArrowheadStyle = msoArrowheadNone Then
If .EndArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadNone
End If
ElseIf .EndArrowheadStyle = msoArrowheadNone Then
If .BeginArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadLong
End If
End If
End With

Case Else
'Debug.Print "donothing"
End Select
Next shp
End Sub

[John Wilson]

It's good. You could probably shorten the select case


Sub ChangeSelectedArrowDirection()
'PURPOSE: change direction of selected arrows
'Rumey Jiffrey 2018
Dim shp As Shape
For Each shp In ActiveWindow.Selection.ShapeRange
Select Case shp.Type
Case Is = msoFreeform, msoAutoShape, msoLine
With shp.Line
If .BeginArrowheadStyle = msoArrowheadNone Then
If .EndArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadNone
End If
ElseIf .EndArrowheadStyle = msoArrowheadNone Then
If .BeginArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadLong
End If
End If
End With
Case Else
'Debug.Print "donothing"
End Select
Next shp
End Sub

[rumj]

It's good. You could probably shorten the select case


Brilliant, thanks. I wasn't aware you could use case like that, and that's why I thought it was bulky. I'll post the code for doing it on all the slides as well for those looking for it.

[rumj]

The code below changes the direction of arrows in all the slides. It's basically the same as above, except for the slide loop, and the reference to shapes within each slide. I've shortened it following John Wilson's advice above



Sub ChangeAllArrowDirection()
'PURPOSE: change direction of arrows in all slides in presentation
'Rumey Jiffrey 2018


Dim sld As Slide
Dim shp As Shape


'Loop through each slide in Presentation
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
Select Case shp.Type
Case Is = msoFreeform, msoAutoShape, msoLine
With shp.Line
If .BeginArrowheadStyle = msoArrowheadNone Then
If .EndArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadNone
End If
ElseIf .EndArrowheadStyle = msoArrowheadNone Then
If .BeginArrowheadStyle > 1 Then
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadLong
End If
End If
End With
Case Else
'Debug.Print "donothing"
End Select
Next shp
Next sld
End Sub