Clickable annual wheel

Hi daredan,

I love your wheel. Try the attached file. However, I didn't implement the year part, because I didn't see any Year segments.

This is how I approached your problem:
a. Macro 'RenameAciveShape()' was used to rename the segments to 'Jan' thru 'Dec'.
b. Macro 'AssignOnActionTextToWheelSegments()' was used to assign Macro 'WheelEventHandler()' as the Event Handler for all Shapes on the Sheet.
c. Macro 'WheelEventHandler()' processes CLICKS on the Wheel and puts the month in cell 'H1'.

Code follows (ordinary code module such as 'Module1'):

Option Explicit

Sub AssignOnActionTextToWheelSegments()
  'This assigns macro 'WheelEventHandler' as the Event Handler for all Shapes on the Sheet
  
  Dim Sh As Object
    
  For Each Sh In ActiveSheet.Shapes
    Sh.OnAction = "WheelEventHandler"
  Next Sh
  
End Sub

Sub RenameAciveShape()

  Dim sNewName As String
  
  sNewName = InputBox("Enter a 3 letter month then select 'OK'", "Rename Wheel Segment Input Box")

  Selection.ShapeRange.Name = sNewName

End Sub



Sub WheelEventHandler()
  'This is the Wheel Segment Event Handler that assigns a month to cell 'H1'
  
  Dim bHaveValidMonth As Boolean

  Dim sMonth As String
  Dim sUpperCaseMonth As String

  'Get the name of the Shape that was selected
  'Debug.Print Application.Caller
  sMonth = Application.Caller
  sUpperCaseMonth = UCase(sMonth)

  'Test to see if the Shape selected was a month
  Select Case sUpperCaseMonth
    Case "JAN"
      bHaveValidMonth = True
    Case "FEB"
      bHaveValidMonth = True
    Case "MAR"
      bHaveValidMonth = True
    Case "APR"
      bHaveValidMonth = True
    Case "MAY"
      bHaveValidMonth = True
    Case "JUN"
      bHaveValidMonth = True
    Case "JUL"
      bHaveValidMonth = True
    Case "AUG"
      bHaveValidMonth = True
    Case "SEP"
      bHaveValidMonth = True
    Case "OCT"
      bHaveValidMonth = True
    Case "NOV"
      bHaveValidMonth = True
    Case "DEC"
      bHaveValidMonth = True
  End Select

  'If the shape selected was a month, then assign the value to cell 'H1'
  If bHaveValidMonth = True Then
    ActiveSheet.Range("H1").Value = sMonth
  End If
  
End Sub

Lewis