この記事では、以下の動画のような回転ルーレットをVBAを使って作成する方法をご紹介していきます。
※実際は何周かしたらこのルーレットは止まります。
昔は職場での抽選作業なんかはみんなで集まってあみだくじとかをしたものですが、それもできなくなった昨今。
ぜひデジタル抽選機としてご利用ください。
それではさっそくやっていきましょう。
ルーレット作成の下準備
まずは以下の画像を参考にどこでも良いのでルーレットのベースとなるマス目を作成していきましょう。
今回は適当なアルファベットにしていますが、各マス目には何を書いていてもOKです。
また、セルの高さ幅をうまく調整し、なるべく正方形に近い形にしておくと雰囲気が出て良いですね。
ルーレット作成のVBAコード
それでは下準備が終わったところで、さっそくVBAコードの記述に移りましょう。
以下がそのサンプルコードです。
Sub roulette()
Dim region As Variant
'ここでマス目の存在領域を指定する
Set region = Range("B2:D4")
'ルーレット作成作業開始
num_r1 = WorksheetFunction.RandBetween(1, 3)
num_r2 = WorksheetFunction.RandBetween(num_r1 * 8, num_r1 * 8 + 7)
num_r3 = WorksheetFunction.RandBetween(0, 7)
For i = num_r3 To num_r2
If i Mod 8 = 1 Then
win = region(1, 1).Address
ElseIf i Mod 8 = 2 Then
win = region(1, 2).Address
ElseIf i Mod 8 = 3 Then
win = region(1, 3).Address
ElseIf i Mod 8 = 4 Then
win = region(2, 3).Address
ElseIf i Mod 8 = 5 Then
win = region(3, 3).Address
ElseIf i Mod 8 = 6 Then
win = region(3, 2).Address
ElseIf i Mod 8 = 7 Then
win = region(3, 1).Address
Else
win = region(2, 1).Address
End If
region.Interior.Color = RGB(255, 255, 255)
Range(win).Interior.Color = RGB(255, 150, 0)
region(2, 2) = Range(win)
Application.Wait [Now()] + 0.05 / 86400
DoEvents
Next
Range(region(2, 2).Address).Interior.Color = RGB(255, 255, 0)
End Sub
基本的には4行目でさきほど作成したマス目の存在領域を指示するだけです。
簡単にどうゆう処理をしているかも解説しておきます。
さきほどのサンプルコードでは以下の画像のように色のついたマス目を回転させています。
そしてこの回転作業を乱数をつかって適当な場所で止めているだけです。
この作業を画像更新させながら行うことによってルーレットのように見えるというわけですね。
ルーレット実行ボタンの作成
最後に先ほどのマクロの実行ボタンを作成していきましょう。
ボタンの作成方法については以下の記事を参考にしてください。
【エクセル】マクロ実行ボタンの作成手順!画像つきで詳細解説!
私の場合はこんな感じにしました。
これでこのルーレットボタンを押すと以下のようにルーレットが開始するはずです。
おわりに
というわけでエクセルVBAをつかって簡単なルーレットを作成する方法をご紹介しました。
職場での抽選作業なんかにぜひご活用ください。
なお、今回は3×3のマス目で作成しましたが、応用すればもっとマス目を増やすことも可能です。ぜひチャレンジしてみてください。
このように、私のブログではエクセルスキルはもちろん、様々なプログラミングスキルを紹介しています。
今は仕事中で時間がないかもしれませんが、ぜひ通勤時間中などに他の記事も読んでいただけると嬉しいです。
⇒興味をもった方は【ヒガサラ】で検索してみてください。
確実にスキルアップできるはずです。
最後に、この記事が役に立ったという方は、ぜひ応援よろしくお願いします。
↓ 応援ボタン
それではまた!
コメント
プログラミングで、ルーレットを作っていて、試しにこちらのサイトのルーレットを作らせていただきました。ルーレットで出た番号によって、その日のごはんの献立が表示される、という形にしたいと思っています。例えば、ルーレットで、1番が選ばれたら、「今日の献立はエビフライです。」という風に、Msgboxで表示したいのですが、どこの場所にプログラミングしたらいいか分かりません。教えていただけると嬉しいです。
ご質問ありがとうございます(^^)
win=region(*,*).Adress
というコードがたくさんあると思いますが、まずはその下に
menu_msg=”「今日の献立はエビフライです。」”
といった形で各番号に対するメッセージを設定していきます。
具体的に書くと
If i Mod 8 = 1 Then
win = region(1, 1).Address
menu_msg=”「今日の献立はエビフライです。」”
ElseIf i Mod 8 = 2 Then
win = region(1, 2).Address
menu_msg=”「今日の献立はカレーです。」”
みたいな感じですね。
そして最後(End Subの前)に
Msgbox menu_msg
を追加すればできると思います。