読者です 読者をやめる 読者になる 読者になる

Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

Powerpoint VBA 三択問題を作る

Powerpoint VBA

だいぶパワーポイントから離れていたので,久々に連休ですし,ちょっと続き物を書いてみます。

クイズみたいなものをパワーポイントでやるポイントを載せていきます。

概要

さて,次のようなものを作りました。まだ最低限の実装ですが,基本的な考え方は入れています。

3択基本①.pptm 直

ファイル名の右についているちっちゃいダウンロードボタンでダウンロードすると,私の環境ではファイル名は文字化けしませんでした。

二つのスライドのみから構成されます。

f:id:chemiphys:20170317231258p:plain

選択肢1~3 と 問題 これら全部にボタンというマクロを動作設定します。

f:id:chemiphys:20170317231311p:plain
スライドは2枚しかありません。しかもそのうち表示用は1枚のみですが,選択肢のボタンを押すと,正誤の判定を行い,問題文を表示したりする図形をクリックすると,次の問題に進む。
10問終わったら 正答数を返すという動きをしています。

VBAコード

標準モジュール

Option Explicit
Public 問題番号 As Long
Public 正解数 As Long

Sub ボタン(oShp As Shape)
    Select Case oShp.Name
        Case "問題"
            Call 次の問題
        Case "選択肢1"
            Call 正誤判定(1)
        Case "選択肢2"
            Call 正誤判定(2)
        Case "選択肢3"
            Call 正誤判定(3)
    End Select
End Sub

Sub 次の問題()
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    Dim 問題表 As Table: Set 問題表 = Sld2.Shapes("問題表").Table
    
    If 問題番号 = 0 Then
        正解数 = 0
    End If
    問題番号 = 問題番号 + 1
Stop
    Sld1.Shapes("問題").TextFrame.TextRange.Text = 問題表.Cell(問題番号 + 1, 2).Shape.TextFrame.TextRange.Text
    Sld1.Shapes("選択肢1").TextFrame.TextRange.Text = 問題表.Cell(問題番号 + 1, 3).Shape.TextFrame.TextRange.Text
    Sld1.Shapes("選択肢2").TextFrame.TextRange.Text = 問題表.Cell(問題番号 + 1, 4).Shape.TextFrame.TextRange.Text
    Sld1.Shapes("選択肢3").TextFrame.TextRange.Text = 問題表.Cell(問題番号 + 1, 5).Shape.TextFrame.TextRange.Text
     
End Sub

Sub 正誤判定(argNo As Long)
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    Dim 問題表 As Table: Set 問題表 = Sld2.Shapes("問題表").Table
    
    Dim Ret As String
    If argNo = CLng(問題表.Cell(問題番号 + 1, 6).Shape.TextFrame.TextRange.Text) Then
        Ret = "正解です おめでとう! 次の問題へ行くにはここをクリック"
        正解数 = 正解数 + 1
    Else
        Ret = "間違いです。正解は" & 問題表.Cell(問題番号 + 1, 6).Shape.TextFrame.TextRange.Text & "番です。" & _
        vbCrLf & " 次の問題へ行くにはここをクリック"
    End If
    Sld1.Shapes("問題").TextFrame.TextRange.Text = Ret
    If 問題番号 = 10 Then
        Ret = Ret & vbCrLf & "10問終わりました。 正答数は " & 正解数 & "です。おつかれさまでした。" & _
        vbCrLf & "再度挑戦するなら,問題をクリックしてください。"
        Sld1.Shapes("問題").TextFrame.TextRange.Text = Ret
        問題番号 = 0
    End If
End Sub

コードの説明

必要な部分の説明を加えます。

Sub ボタン(oShp As Shape)

こう書いたマクロを図形の動作に設定すると,oShpという変数にトリガーの図形を取得できます。

Public 問題番号 As Long
Public 正解数 As Long

常にループ待機等をしているわけではありません。ボタンを押したら,という動きになります。
そのため,プロシージャは必要な時しか動かないので,値が消えないようPublic宣言をしています。

Dim 問題表 As Table: Set 問題表 = Sld2.Shapes("問題表").Table

表のセルを多数扱う場合は,Tableオブジェクトをオブジェクト変数に入れておいて,使うと楽です。

Sld1.Shapes("選択肢1").TextFrame.TextRange.Text = 問題表.Cell(問題番号 + 1, 3).Shape.TextFrame.TextRange.Text

Powerpointの表はアクセスが深いです。
Cell(行,列).Shape.TextFrame.TextRange ・・・とたどっていかないといけないのが難点ですね。

必要な説明はこのくらいでしょうか。とても短いマクロと少ない部品ですが,多数の問題を同じレイアウトで取り扱えます。

内容は極めて雑に作っていますが,発展させればなかなかのものが作れるんじゃないかなーと思われます。

次回は,選択肢をランダムにすることを考えてみます。(ΦωΦ)