Drawing Powerpoint lines in a circle

Hi experts!

I seldom program graphics so I have no idea if what I want is difficult but here it is. I have attached an example of some arrows that I hand drew. I would like a Powerpoint VBA macro that could draw from 2 to 25 such vectors all from a central point outward.

Have a great day.
Ed MatsuokaPartner/Senior IT SpecialistAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jamie GarrochSenior Technical Consultant at BrightCarbonCommented:
Try this Ed:

Option Explicit

' ================================================================================
' PowerPoint VBA Macro
' ================================================================================
' Purpose       : Create a number of lines in a circle all starting from the same
'                 point and ending at a random point defined by a min/max range.
' Example Call  : DrawArrows 25
' ================================================================================
' Writtebn by   : Jamie Garroch of YOUpresent (http://youpresent.co.uk)
' Date          : 02 APRIL 2018
' EE Question   : 29092338
' ================================================================================
Sub DrawArrows(lNumArrows As Long)
  Dim oSld As Slide
  Dim Xstart As Single, Ystart As Single
  Dim Xend As Single, Yend As Single
  Dim XrangeTo As Single, YrangeTo As Single
  Dim lArrow As Long
  ' Check that a slide is in view
  On Error Resume Next
  Set oSld = ActiveWindow.View.Slide
  If Err Then
    MsgBox "Please make sure a slide is in view first.", vbCritical + vbOKOnly, "No Slide in View"
    Exit Sub
  End If
  On Error GoTo 0
  With ActivePresentation.PageSetup
    ' Define the starting point for the arrows
    Xstart = .SlideWidth / 2
    Ystart = .SlideHeight / 2
    ' Define the range of the length for the lines
    Const XrangeFrom = 50
    Const YrangeFrom = 50
    XrangeTo = .SlideWidth * 0.8 ' maximum X = 80% of the slide width
    YrangeTo = .SlideHeight * 0.8 ' maximum Y = 80% of the slide height
  End With
  ' Add the specified nuber of arrows to the current slide
  For lArrow = 1 To lNumArrows
    ' generate random coordinates in the specified range using : (upperbound - lowerbound + 1) * Rnd + lowerbound
    Xend = (XrangeTo - XrangeFrom + 1) * Rnd + XrangeFrom
    Yend = (YrangeTo - YrangeFrom + 1) * Rnd + YrangeFrom
    With oSld.Shapes.AddLine(Xstart, Ystart, Xend, Yend).Line
      .BeginArrowheadStyle = msoArrowheadNone
      .EndArrowheadStyle = msoArrowheadTriangle
      .Weight = 0.5
    End With
End Sub

Open in new window

To use it, open the VBE (Visual Basic Editor) by pressing Alt+F11. Click Insert / Module and then paste the code into the module window that opens. Press Ctrl+G to open the Immediate Window. Type "DrawArrows 25" and hit return.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Ed MatsuokaPartner/Senior IT SpecialistAuthor Commented:
Hi Jamie!

That is perfect. You rock.
Jamie GarrochSenior Technical Consultant at BrightCarbonCommented:
Thanks Ed. If the solution works for you, don't forget to award the points to close and save the question.
Ed MatsuokaPartner/Senior IT SpecialistAuthor Commented:
This does exactly what I wanted, creates the number of vectors I specify, and creates them, and the response time was amazingly quick.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.