TTak's Office Excel 円形ルーレットを作りたい(EXCEL2010)

　円形ルーレットを作りたい
　

　　
要API/サンプル有

○ポイントはドーナツグラフのSeriesCollection コレクションオブジェクト

　ルーレットといえば、やっぱり円形。ルーレットをEXCELで作っておいて、ゲームの時に使えば、「おっ」と驚かせることができるかもしれませんね。そこで、ドーナツグラフを使ってハイライトがクルクル回るルーレットを作ってみましょう。

(1) ドーナツグラフの系列を作成
　（この例ではセルA1からA20までの全部のセルに数値 1 を入力します）

(2) セル　A1:A20 を選択して [挿入]タブ＞「グラフ」グループの[その他のグラフ]リボン＞[ドーナツ]として、ドーナツグラフを作成（図1） office

（図1）ドーナツグラフ

(3)ドーナツグラフを選択（図2）して、グラフツールの[書式]タブ＞「図形のスタイル」グループの[図形の枠線]プルダウン＞として、ドーナツの区切り枠線の色（図3）と、ドーナツの各系列の色（図4）を決める
　（この例では枠線を黒、各系列を白とします）
office

（図2）ドーナツグラフを選択

office

（図3）ドーナツグラフの枠線色を決める

office

（図4）ドーナツの各系列の色を決める

(4) ドーナツグラフの系列（A列）を選択し、右クリック＞ショートカットメニュー＞[非表示(H)]として、データ系列を非表示化

(5) グラフエリアをクリックしてグラフオブジェクトを選択

(6) 名前ボックスに Roulette と記入（図5）
　（この例では Roulette という名前をマクロから呼び出します）
office

（図5）グラフオブジェクト名の設定

(7) VBEを開いて標準モジュールにコードを記入。コード例は下記

'Declare function は必ず標準モジュールに記入
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

'ここからがルーレットマクロ本文---
Sub ROULETTE_GAME4()
'ビジュアルルーレット
Dim slpTime As Integer
Dim myRandSpan As Integer
Dim rt As Integer
Dim i As Integer
Dim bc As Integer
Dim hc As Integer
Dim myNum As Integer

'抽選範囲
myRandSpan = 20

'円グラフ範囲再設定
Range("A:A").ClearContents
For i = 1 To myRandSpan
   Cells(i, 1).Value = 1
Next i

'回転数
rt = 3
'切替間隔の増分
slpTime = 4
'myRandSpanが大きい場合は rt, slpTime は小さい
'値にしてください

'ベースカラー
bc = 2
'ハイライトカラー
hc = 3

'抽選
Randomize
myNum = Int(Rnd() * myRandSpan)
With ActiveSheet.ChartObjects("Roulette").Chart
  .SetSourceData Source:=Sheets("Sheet1"). _
    Range("A1:A" & myRandSpan), PlotBy:=xlColumns
  .SeriesCollection(1).Interior.ColorIndex = bc

   '開始位置までのハイライト移動
  If myNum > 2 Then
   For i = 1 To myNum - 1
     Sleep slpTime
     With .SeriesCollection(1)
       .Points(i + 1).Interior.ColorIndex = hc
       .Points(i).Interior.ColorIndex = bc
     End With
     DoEvents
   Next i
  End If

   'メインルーレット
  For i = 1 To rt * myRandSpan + 1
    Sleep i * slpTime
    With .SeriesCollection(1)
      .Points(myNum + 1).Interior.ColorIndex = hc
      If myNum = 0 Then
       .Points(myRandSpan).Interior.ColorIndex = bc
      Else
       .Points(myNum).Interior.ColorIndex = bc
      End If
    End With
    myNum = myNum + 1
    myNum = myNum Mod myRandSpan
    DoEvents
  Next i
End With
End Sub

○基本構成

　まずグラフの要素数を抽選範囲の数に合わせる処理を行います。そのために、便宜上グラフの参照するセルの範囲に数値の 1 を入力しグラフの範囲を再設定します。

　次に、抽選範囲内で乱数を発生させ、SeriesCollectionコレクションオブジェクトのPointsプロパティのインデックス値を 1 ずつ増やし、ColorIndexプロパティでハイライトカラーに変えてゆきます。このとき、Pointsプロパティのインデックス値で、色を変えた一つ前のインデックス値のColorIndexプロパティはベースカラーに戻してゆきます。

　抽選範囲の最大値になったら、Pointsプロパティのインデックス値は再び 1 に戻します。これをループさせながら、Sleep API関数を挟んで少しずつループ速度を落としてゆきます。

○関連情報・その他の方法

・EXCEL2000の場合はこちら
・ルーレットを作る(EXCEL2010)

○サンプル

・サンプルファイルはこちら（要解凍） 14KB

○注意

・抽選範囲myRandSpanが大きい場合 rt, slpTime は小さい値にしなければ、ルーレットの数字の切り替わりが最後の方で間延びします。
・マクロを途中で止める場合は、Escキーを押してください。