Consulting

Results 1 to 4 of 4

Thread: VBA Powerpoint to switch selected arrow directions on slide

  1. #1
    VBAX Newbie
    Joined
    May 2018
    Posts
    3
    Location

    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

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,687
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    May 2018
    Posts
    3
    Location
    Quote Originally Posted by John Wilson View Post
    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.

  4. #4
    VBAX Newbie
    Joined
    May 2018
    Posts
    3
    Location
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •