Drawing Powerpoint lines in a circle

Ed Matsuoka
Ed Matsuoka used Ask the Experts™
on
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.
VectorExample.pptx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Senior Technical Consultant at BrightCarbon
Commented:
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
  Next
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.
Ed MatsuokaPartner/Senior IT Specialist

Author

Commented:
Hi Jamie!

That is perfect. You rock.
Jamie GarrochSenior Technical Consultant at BrightCarbon

Commented:
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 Specialist

Author

Commented:
This does exactly what I wanted, creates the number of vectors I specify, and creates them, and the response time was amazingly quick.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial