Excelでルーレットを作りました

2024年1月26日 16:22

先日、買ってみようかな(*˘︶˘*).｡.:*♡と思うカリンバを見つけました。楽しみに待っていたのですが、販売の告知が出ても出てもすぐにSOLD OUTになり、出品サイトはピラニア沼のような状態になっていました（笑）
入手できないのは残念でしたが、カリンバを楽しむ人の多さ、熱気を感じられる眩しい光景でした。

「えぇい、いいんだぃ、いいんだぃ、これは、きっと何か前向きに違うものを見てごらん、という神のお告げんなんでぃ。ｲｼﾞｲｼﾞ🥺」ということで、カリンバの販売サイトをそっと閉じて、久しぶりにExcelのVBAでルーレットの作り方を学ぶことにしました。

下記は、今回作成した『Excel_de_roulette.xlsm』を開いた時の画面です。
ルーレットの画像をクリックすると、人物名を入力したマス目をオレンジ色のルーレットが回ってランダムに誰かのところで止まってくれるというものです。

▲ 画面１　ルーレットを回す前の画面。ルーレット画像をクリックすると抽選が始まります。

今回作成した『Excel_de_roulette』のマクロソースはこちら👇

Sub roulette()
    Dim region As Variant
    'マス目の領域を指定する
    Set region = Range("B2:F4")
    'ルーレット作成作業開始
    num_r1 = WorksheetFunction.RandBetween(1, 3)
    num_r2 = WorksheetFunction.RandBetween(num_r1 * 12, num_r1 * 12 + 11)
    num_r3 = WorksheetFunction.RandBetween(0, 12)
    num_r4 = WorksheetFunction.RandBetween(num_r2 * 12, num_r2 * 12 + 11)
    num_r5 = WorksheetFunction.RandBetween(2, 6)
    
    
    For i = num_r5 To num_r2
        If i Mod 12 = 1 Then
            win = region(1, 1).Address
        ElseIf i Mod 12 = 2 Then
            win = region(1, 2).Address
        ElseIf i Mod 12 = 3 Then
            win = region(1, 3).Address
        ElseIf i Mod 12 = 4 Then
            win = region(1, 4).Address
        ElseIf i Mod 12 = 5 Then
            win = region(1, 5).Address
        ElseIf i Mod 12 = 6 Then
            win = region(2, 5).Address
        ElseIf i Mod 12 = 7 Then
            win = region(3, 5).Address
        ElseIf i Mod 12 = 8 Then
            win = region(3, 4).Address
        ElseIf i Mod 12 = 9 Then
            win = region(3, 3).Address
        ElseIf i Mod 12 = 10 Then
            win = region(3, 2).Address
        ElseIf i Mod 12 = 11 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, 3) = Range(win)
        Application.Wait [Now()] + 0.05 / 86400
        DoEvents
    Next
    Range(region(2, 3).Address).Interior.Color = RGB(255, 255, 0)
    
    'メッセージを表示する
    msg = MsgBox(Range("D3") & "さん、おめでとうございます＼(^o^)／", vbYes + vbQuestion, "抽選結果")
    
    If alert = vbYes Then
    End If
    
    'OKボタンを選択後、resetマクロを呼ぶ
    Call reset
End Sub

Sub reset()
' reset Macro
' D3セル値をクリアする
    Range("D3").Select
    Selection.ClearContents

' BからF列までのセルの色をすべてクリアする
    Columns("B:F").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ' A1のセルを選択する
    Range("A1").Select
End Sub

ルーレット画像を準備してマクロを割り当てます。マス目に好きなようにお名前や数字等を入力したら、ルーレットスタート！

プレゼント企画が盛り上がりそうなExcelマクロ。ご興味のある方がいましたら試してみてはいかがでしょうか😁🎁✨

注）必要なマス目の数により、ソースの修正が必要になります。

『Excel_de_roulette』はこちらからダウンロードできます👇

⚠ 使用時の注意点
Windowsのアップデートにより、ネット上からダウンロードしたExcelファイルを最初に開く際にアラートが表示されるようになりました。その場合には、下記の操作をするとExcelマクロが使用できるようになります。必ず下記の設定をご確認くださいね！

今回は、錚々たるメンバーと抽選会ができるという面白いマクロの実験ができました。こんなふうにカリンバもいつか当たってくれるといいなぁ🥺💕

あぁぁ！この記事アップした後、もう一度サイトを見たら欲しかったカリンバ小僧さんのオリジナルカリンバが注文できました！！
ルーレットの神様ありがとう！！！（完）

↓↓ カリンバ小僧さんのオリジナルカリンバ Yahoo！フリマサイト ↓↓

↓↓ わたしが持っているアイテム紹介です ↓↓

最後までお読みいただきありがとうございました(*˘︶˘*).｡.:*♡

Excelでルーレットを作りました

いいなと思ったら応援しよう！