Powerpoint VBA 三択問題を作る ② 問題準備・選択肢部分
三択問題作りその2 です。
chemiphys.hateblo.jp
これの続き
問題データの取り扱い部分に集中してお届けします。
以前,大量データの扱いでお世話になったものをPowerpointに適用してみました。
thom.hateblo.jp
こちらのコードは,実務でもとても扱いやすく使ってますし,抽出その他のメンテナンスもし易くて,本当に重宝しています。
パワーポイントの表のデータはとても小さいんですが,この考え方は使いたいと思い,パワーポイント用に自分なりに適用しなおしてみました。
プロ版やめたので,ダウンロードリンクは消去
目次
モジュールがかなり増えてきていますので,全部は載せません。上記のファイルをダウンロードして試されてください。
大丈夫なはずですが,テストするのも自己責任でお願いします。
表の変更点は,前回は 選択肢1,2,3 と正答を表に書いていましたが,どうせランダムに並べるなら 正答を最初に書いて,誤答2つを並べるというふうに変わっています。
さて,元のデータ構造が変わってもコードの書き換えが最小限で済むように,Enumを利用します。Excelの時ほどではありませんが,宣言用に1つ標準モジュールを使用しています。
標準モジュール
m00宣言
Public Const 問題表列数 = 6 Enum M 番号 = 1 問題 正答 誤答1 誤答2 備考 End Enum
今のところはこれだけですが,回答を収めるほうもコレクションで作っていきたいので,後々その分も宣言に増えていきます。
Module1
ここで実際の処理をします。
まだ,表示部分等には手を加えていないので,前回から変わった部分だけ。
Public 問題集 As Collection
宣言部分に問題集のコレクションが追加されています。
Function RandArray(argMax As Long) As Variant Dim Col As Collection: Set Col = New Collection Dim Arr(): ReDim Arr(1 To argMax) Randomize Dim i As Long For i = 1 To argMax Col.Add Rnd Next Dim tmp As Long, c For i = 1 To argMax tmp = 0 For Each c In Col If c < Col(i) Then tmp = tmp + 1 Next Arr(i) = tmp + 1 Next RandArray = Arr End Function Function GetDataAsCollection() As Collection Dim SourceTable As PowerPoint.Table Set SourceTable = ActivePresentation.Slides(2).Shapes("問題表").Table Set 問題集 = New Collection Dim Arr: ReDim Arr(0 To SourceTable.Rows.Count, 1 To 問題表列数) Dim i, j, r As Row, c As Cell i = 0 For Each r In SourceTable.Rows j = 1 With New 問題 For Each c In r.Cells .LetParameter j, c.Shape.TextFrame.TextRange.Text j = j + 1 Next 問題集.Add .Self End With i = i + 1 Next 問題集.Remove 1 'Test Dim 問 As 問題 Dim 問題順 As Variant 問題順 = RandArray(10) Dim 選択肢順 As Variant 'Test For i = 1 To 10 Set 問 = 問題集(問題順(i)) 選択肢順 = RandArray(3) Debug.Print "問題番号" & 問.番号 & " : " & 問.問題, _ "選択肢1:" & 問.選択肢(CLng(選択肢順(1))), " ,選択肢2:" & _ 問.選択肢(CLng(選択肢順(2))), " ,選択肢3:" & 問.選択肢(CLng(選択肢順(3))), _ " ,正答:" & 問.正答 Next Stop End Function
前回のRandArray関数と コレクションを使って表のデータを扱う部分が追加されています。
問題.cls
データ構造を規定しているクラスです。
Option Explicit Private Parameter(1 To 問題表列数) Property Get 番号() As Long 番号 = GetParameter(M.番号) End Property Property Get 正答() As String 正答 = GetParameter(M.正答) End Property Property Get 問題() As String 問題 = GetParameter(M.問題) End Property Property Get 選択肢(argNo As Long) As String If argNo > 3 Or argNo < 1 Then Exit Property 選択肢 = GetParameter(M.正答 + argNo - 1) End Property Sub LetParameter(argParameterNo, argValue) Parameter(argParameterNo) = argValue End Sub Function GetParameter(argParameterNo) As Variant GetParameter = Parameter(argParameterNo) End Function Property Get Self() As Object Set Self = Me End Property
GetParameter,LetParameterを使わせてもらっています。引数にはargを使うという自分ルールを今はやっているので,そのあたりはオリジナルコードから変わっています。
選択肢を数値で扱えないとRandArrayが活きないので,引数を取れる形で用意。
とりあえずこのあたりが変更点です。
GetDataCollectionの実施結果
実際に問題には今は活きていないのですが,
GetDataCollectionでやれていることについて触れます。
実行すると,現在はイミディエイトウィンドウにわーっと出力します。
問題番号2 : Baは何の元素か。 選択肢1:バッテリー ,選択肢2:バリウム ,選択肢3:バウム ,正答:バリウム
問題番号5 : Znは何の元素か。 選択肢1:亜鉛 ,選択肢2:フェライト ,選択肢3:鉄 ,正答:亜鉛
問題番号1 : Naは何の元素か。 選択肢1:カリウム ,選択肢2:カルシウム ,選択肢3:ナトリウム ,正答:ナトリウム
問題番号7 : Mgは何の元素か。 選択肢1:マグネット ,選択肢2:マグネシウム ,選択肢3:マンガン ,正答:マグネシウム
問題番号8 : Heは何の元素か。 選択肢1:フロン ,選択肢2:ヘロン ,選択肢3:ヘリウム ,正答:ヘリウム
問題番号9 : Liは何の元素か。 選択肢1:リプライ ,選択肢2:リプトン ,選択肢3:リチウム ,正答:リチウム
問題番号3 : Caは何の元素か。 選択肢1:ホネセイブン ,選択肢2:カルシウム ,選択肢3:カリウム ,正答:カルシウム
問題番号10 : Beは何の元素か。 選択肢1:ベリリリウム ,選択肢2:ベリウム ,選択肢3:ベリリウム ,正答:ベリリウム
問題番号6 : H は何の元素か。 選択肢1:ヒ素 ,選択肢2:ヒドラ ,選択肢3:水素 ,正答:水素
問題番号4 : Feは何の元素か。 選択肢1:鉄 ,選択肢2:亜鉛 ,選択肢3:フェライト ,正答:鉄
実行のたびにかわるので一例です。
このように,問題の実施順と,選択肢を入れ替えることに成功していることは,確認ができます。
GetDataCollectionの補足
コードの説明をします。
Dim SourceTable As PowerPoint.Table Set SourceTable = ActivePresentation.Slides(2).Shapes("問題表").Table Set 問題集 = New Collection Dim Arr: ReDim Arr(0 To SourceTable.Rows.Count, 1 To 問題表列数) Dim i, j, r As Row, c As Cell
パワーポイントのテーブルは階層が深いのでTableをオブジェクト変数に入れます。
Arr配列は使ってないや(;´▽`A``もう面倒なので残ったまま。すみません。ツカッテマセン。
For Eachをどうしても使ってみたかったので,rをRowオブジェクトとして,cをCellオブジェクトとして宣言。
たしかにFor Eachを使うメリットはないかもしれませんが,ローカルウィンドウを見たところ,
Rowsコレクション→Rowオブジェクト→Cellsコレクション→Cellオブジェクト という階層で存在していたので,使ってみました。
i = 0 For Each r In SourceTable.Rows j = 1 With New 問題 For Each c In r.Cells .LetParameter j, c.Shape.TextFrame.TextRange.Text j = j + 1 Next 問題集.Add .Self End With i = i + 1 Next 問題集.Remove 1
最初は一度Arrに放り込んで・・と思っていたんですが,直接LetParameterを使えたのでなかなか簡単に書けている気がしています。
Dim 問 As 問題 Dim 問題順 As Variant 問題順 = RandArray(10) Dim 選択肢順 As Variant 'Test For i = 1 To 10 Set 問 = 問題集(問題順(i)) 選択肢順 = RandArray(3) Debug.Print "問題番号" & 問.番号 & " : " & 問.問題, _ "選択肢1:" & 問.選択肢(CLng(選択肢順(1))), " ,選択肢2:" & _ 問.選択肢(CLng(選択肢順(2))), " ,選択肢3:" & 問.選択肢(CLng(選択肢順(3))), _ " ,正答:" & 問.正答 Next Stop
RandArrayは一気にVariantに放り込まないと意味がないのでそういうフレーズが2ヶ所。
問題順をランダムにするために,iは1→10の順で変わりますが,それを問題順(i)に入れることで問題順をランダムにしています。
選択肢もそんな感じでランダムにしています。
今はメイン部分とまだ連携させていないので,その結果をDebug.Printで出力している感じです。
だいたいこんなところ・・ですね。あんまり解説していない・・。
最後に
このつくり方の優れた点は,データを取り出す際にEnumによる連想配列的な使い方,コードのメンテナンスのしやすさと数字でも制御できるハイブリッドな点です。
使いたいプロパティもGetProperty関数でいくらでも追加できますし,追加しなくても直接GetProperty関数&Enumで楽に利用できます。
PowerpointのTableオブジェクトでFor Each ステートメントが十分に使えたとは言えませんが,
全ての行について,すべてのセルの値をコレクションに放り込んだんだよ,という意思がFor Eachで書くと込めれます。
だからでしょうね,私がFor Each好きなのは。。コードに意思を感じるステートメントです。(個人の見解です)
形としては好きな雰囲気で組めました。
次回書くときはちゃんと動くように,そして回答をコレクションに保持させるように作ります。