VBA Powerpoint to switch selected arrow directions on slide

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

Code:

---

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

---

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

Code:

---

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

---

Quote:

---

Originally Posted by John Wilson

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.

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

Code:

---

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

---