コピペで作れるPowerPointVBAの景品ルーレット

2026/03/24
MS Office
PowerPoint, VBA

Excelのビンゴゲームと一緒に昨年末に作ったやつです。ダララララララ……ジャン！！って音を付けると意外と盛り上がって悪くなかったです。

こんなかんじ

1枚目のスライドにスタートボタン、2枚目以降に景品のスライドを用意します。

スライドショーモードでスタートボタンをクリックすると、2枚目以降のスライドがランダムに表示されます。指定時間経過するとストップします。

景品は2枚以上、計3枚以上のスライドがないと動きません。ルーレット時間、スライド切替の間隔をそれぞれ指定できます。音声ファイルを指定できるので、フリーのドラムロールなどを利用するのがおすすめです。音が終わるときにルーレットが止まるように時間を調節してください。

景品スライドにはそれぞれ削除ボタンも付けておきます。スライドショーモードのまま、これをクリックすると、現在のスライドが削除され、1枚目のスタートボタンのスライドへ移動します。存在するスライドのみでルーレットするので、だんだん減っていって、最後の1枚になったら終了です。

コード

VBEで標準モジュールを作って、以下をコピペしてください。先にコードがないとスライドのボタンへ割り付けができません。マクロ付きPowerPointファイルは拡張子 .pptm です。

2～3行目で秒数を調整できます。

'==========================================
Const SPIN_SEC As Double = 4.5 'ルーレットがまわっている時間（秒）
Const WAIT_SEC As Double = 0.1 'スライド切替間隔（秒）
'==========================================

Sub start()
  '# ルーレットメイン処理
  
  'アクティブプレゼンテーション
  Dim pt As Presentation
  Set pt = ActivePresentation
  
  'スライド枚数取得
  Dim slideCount As Long
  slideCount = pt.Slides.Count
  If slideCount <= 2 Then Exit Sub 'スライド数が2枚以下なら終了
  
  'ランダムの初期化
  Randomize
  
  'スタート時刻を保持
  Dim startTime As Double
  startTime = Timer
  
  'ルーレット
  Dim lastIndex As Long, randIndex As Long
  Do While Timer - startTime < SPIN_SEC '指定間隔のあいだ繰り返す
    Do While randIndex = lastIndex '前回の番号と同じだったら繰り返す（かぶり防止）
      randIndex = Int(((slideCount - 1) * Rnd) + 1) '景品ぶんの整数をランダムに取得
    Loop
    lastIndex = randIndex 'どの番号だったか保持しておく
    
    pt.SlideShowWindow.View.GotoSlide randIndex + 1 'スライド表示
    DoEvents
    
    Call Wait(WAIT_SEC) '待機（秒）
  Loop
End Sub

Sub Wait(ByVal sec As Double)
  '# 指定の秒数待機
  
  Dim t As Double: t = Timer
  Do While Timer < t + sec
    DoEvents
  Loop
End Sub

Sub deleteSlide()
  '# 1枚目に移動して現在のスライドを削除
  
  '確認メッセージ（不要なら削除してください）
  If MsgBox("このスライドを削除します。よろしいですか？", vbOKCancel, "確認") = vbCancel Then Exit Sub
  
  'アクティブプレゼンテーション
  Dim pt As Presentation
  Set pt = ActivePresentation
  
  '現在のスライド番号を取得
  Dim tgtSlideNum As Long
  tgtSlideNum = SlideShowWindows(1).View.CurrentShowPosition
  
  '先頭へ移動
  pt.SlideShowWindow.View.GotoSlide 1
  
  '指定スライドを削除
  pt.Slides.Item(tgtSlideNum).Delete
End Sub

動作設定ボタン

1枚目にスタートボタンを配置します。挿入→図形→動作設定ボタンの、一番右の無地のものを選択します。

スライド上でクリックするとボタンができるので、「start」プロシージャと音声ファイルを設定します。

右クリックしてテキストを追加したり、お好みの色に変更します。

景品用のスライドには、上記と同じように動作設定ボタンで目立たないようなデザインにして、「deleteSlide」プロシージャを割り当ててください。このボタンは景品用スライドすべてに設置します。1つ作ってコピペするとカンタンです。

ひとこと

ビンゴで当たった人にこのルーレットのスタートボタンをクリックしてもらったのですが、本番、なぜだか上手に押せない人が多発したので経験談を残しておきます。

普段となんら変わらぬマウス操作のはずなのに、スタートボタンを狙ってクリックできなかったり、画面のボタンを直接タッチしようとする人も少なくなかったです。見慣れているはずの普通のノートPCなのに！！　酔ってるから？？？　それと、ストップも自分でクリックするのかと迷う人もいたので、最終的にはこちらでマウスポインタをボタン上にのせて、動かないように固定してあげて、マウス左ボタンを指さして「1回だけここを押してください。勝手に止まります。」と言ってあげるのが、一番問題がなかったです。

ご参考になれば幸いです。

公開日：2026/03/24