Thursday, April 24, 2025

Excel Fortune Wheel

In this post we see how to create a fortune wheel game in Excel using VBA macros. The wheel is made of grouped pie shapes. We learn here how to add them and format the alignment to fit each of them into the wheel. The wheel can rotate in various ways. We also see how to capture mouse move to spin the wheel in Excel. Finally, we use the rotation to know which wedge of the wheel is the winner.


Create the Wheel

The fortune wheel in Excel is made of grouped pie shapes. We add a pie auto shape in Excel as indicated below. Find the full list of AutoShape objects in Excel in this other page.

 
  Dim shp As Shape
  Set shp = ActiveSheet.Shapes.AddShape(msoShapePie, 50, 50, 150, 150)

 

The slice of the pie shape can be adjusted with the Adjustments property for two points that determine the angle. By default, the pie is aligned with a 90 degree angle from the full circle (Adjustments(1) is 0 and Adjustments(2) is -90 degrees). Changing the value of one or both Adjustments changes the portion of the slice (or wedge in a wheel) that is visible.


 

Here’s how we calculate the value for Adjustments. The value depends on the number of portions (i.e., slices or wedges) the pie has. For example, a pie with four portions gets 360/4 = 90 degrees per portion. We only need to move one of the Adjustments point by 90 degrees with respect to the other in order to get the portion.

 
  Dim portions As Integer, d As Integer
  portions = 4
  d = 360 / portions
  With shp
      .Adjustments(1) = .Adjustments(2) - d
  End With


 

This version of fortune wheel in Excel allows to choose the number of wedges from 3 to 16. We loop through the number of portions and adjust the slice accordingly. See below a slightly different way to do by setting the value of both Adjustments. The code also sets a different color for each slice and assigns a macro that will be used later to spin the wheel with the mouse cursor.


  'get portions and d as per code above
  For n = 1 To portions
      Set shp = ActiveSheet.Shapes.AddShape(msoShapePie, 50, 50, 150, 150)
      deg = 360 - (d * (n - 1)) - 90
      With shp
          .Name = "p" & n  'name of the portion will be used later
          .Adjustments(1) = deg - d
          .Adjustments(2) = deg
          .Fill.ForeColor.RGB = RGB(r, g, b)  'random numbers between 0 and 255
          .Line.Visible = msoFalse
          .OnAction = "MoveIt"  'assign macro to move with mouse
      End With
  Next n



Finally, all those pie shapes need to be grouped into one. There are several ways to do it. This version of fortune wheel in Excel creates an array of shapes to group them. Download the file at the bottom of this post to see the code.

 

Spin the Wheel

The program spins the wheel using the Rotation property of the shape. The increment it adds (or subtracts) to the current rotation level depends on the speed generated to spin the wheel. This version of fortune wheel in Excel has various options to spin the wheel (one-click button, button press/release, mouse move). All of them increase (or decrease) the speed over a period of 1 or 2 seconds using the function Timer. The code below accelerates the wheel by 0.001 per interval over 2 seconds.

 
  startT = Timer
  Do While runT < startT + 2  'loop for 2 seconds to accelerate
      DoEvents
      speed = speed + 0.005
      shp.Rotation = shp.Rotation – speed  'rotate during acceleration (clock-wise)
      runT = Timer
  Loop


In order to spin the wheel with the mouse, the macro gets the initial cursor position and cursor position after one second has elapsed. The greater the distance between the two positions, the faster the speed. Here’s how we get the mouse cursor position.

 
  Private Declare PtrSafe Function GetCursorPos Lib "User32" (Point As POINTAPI) As Long
  Private Type POINTAPI
      X As Long
      Y As Long
  End Type
 
  Function Cursor() As Variant
      Dim Hold As POINTAPI, arr(2) As Long
      GetCursorPos Hold
      arr(0) = Hold.X
      arr(1) = Hold.Y
      Cursor = arr
  End Function


After acceleration for over 1 or 2 seconds, another macro is used to decelerate the wheel. In a simple way, and in just one direction, the code would look as follows. The code you will find in the Excel fortune wheel for download below is more complicated because it considers various situations (spin in both directions, minimum speed to spin, etc).

 
  Do While speed > 0
      speed = speed - 0.001 
      shp.Rotation = shp.Rotation - speed  'rotate during deceleration
  Loop


Get the Winner

When the wheel stops, another macro gets the winner. That can be calculated from the number or portions and the rotation level of the grouped shape. Remember that all the individual pie shapes were grouped to create the fortune wheel. That grouped shape is assigned to the object variable shp that the macro below accepts as argument. The macro gets the number of shapes in the group, which is equivalent to the number of portions specified when the wheel was created. Then it calculates the corresponding number for the winner wedge. See below the full macro.

 
  Sub GetWinner(shp As Shape)
      Dim portions As Integer, deg As Single, num As Integer, rot As Single
      portions = shp.GroupItems.Count 
      rot = shp.Rotation
      deg = 360 / portions
      num = Int(rot / deg) + 1
      If num > portions Then num = 1
      Call ShowPart(num, portions)
  End Sub


Another macro (ShowPart) adds a glowing effect for one second to the pie slice shape for the winner wedge. Here’s where we use the name of the specific pie shape for the winning wedge. The code below sets a yellow glow around that shape for one second.

 
  Set shp = Sheet1.Shapes("p" & n)
  targetT = Timer + 1
  Do While runT < targetT
      DoEvents
      With shp
          .ZOrder msoBringToFront
          .Glow.Radius = 5
          .Glow.Color = vbYellow
      End With
      runT = Timer
  Loop
  shp.Glow.Radius = 0


 

That macro also adds points to the table next to the fortune wheel. That table is cleared every time we create a new fortune wheel in Excel.

  

Download Excel Fortune Wheel


No comments:

Post a Comment

Popular Posts