スライドショー中にファイルにアクセスしてスライドショーの内容を変更する

# 参考ページ
https://docs.microsoft.com/ja-jp/office/vba/api/overview/
https://www.relief.jp/PowerPoint-VBA/

#目的
新年度になり、飲み会の余興でチーム対抗クイズをしたいということなった。
新たにアプリを作ったりするのは、手間が大きいので、パワポを使って行うことになったが、
パワポはそのままではスライドショー中に内容を変更できないため、
得点の表示をすることが難しかったので、VBAを使って簡単なマクロを組んで
得点を表示をできるようにしたい。

#イメージ
![qiita.gif](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/906730e3-2c6c-9fb9-bb3c-38232091fe1b.gif)
ここでは「テスト青」が正解したとする。

#仕様
2台のPCからアクセスできる領域(2台のPCのどちらかをファイル共有可能にする、NASを使うなど)にcsvファイルを置き、クイズと得点を表示をするスライドの得点表にcsvの内容を反映させる。
これを定時実行させる(実際は定時実行はできなかったので、次のスライドに移動する、もしくはボタンを押すと反映するようになっている)

#環境
vbaが動けばいいので、MacOS(OSX含む)、Windowsはあまり関係ないと思われる。
自分が動かした環境は
MacOS 10.14.3（18D109）が2台
Microsoft PowerPoint for Mac 16.16.9

スライドには2行の表がある。
<img width="319" alt="スクリーンショット 2019-04-27 9.17.30.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/4f9acaab-1b92-25fd-b4cc-701147d280e7.png">

csvファイルは2行であり、2行めには各チームの得点が入っている。
<img width="326" alt="スクリーンショット 2019-04-27 9.19.38.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/a99c84c3-b902-09d1-c1e3-c6a8819a22a4.png">


#マクロの書き方
<img width="1438" alt="スクリーンショット 2019-04-27 8.47.02.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/fa810d88-2a69-b268-8add-65543f640d22.png">
マクロをクリックして編集をクリックすると編集画面が出るので、そこで書き込む.。

#ソースコード
``` vba:全体

Sub point()
    
    DoEvents

    Dim os As String

    Dim cells() As String  ' 表内の文字列格納用配列
    Dim s_cnt As Long   ' スライド数格納用
    Dim r As Long       ' 行方向ループのカウンタ
    Dim c As Long       ' 列方向ループのカウンタ
    Dim s As Long       ' スライドループのカウンタ
    
    Dim sh_cnt As Long 'shpを持っているかを確認するカウンタ
    Dim sh_has() As Boolean 'shp を持っているか
    
    Dim point_stg As String 'csvの中身
    Dim point() As String 'csv の中身を分割したもの
    
    s_cnt = ActivePresentation.Slides(ActivePresentation.Slides.Count).SlideNumber ' スライドの総数を取得
    
    ReDim sh_has(1 To s_cnt)
    
    sh_cnt = 1
    
    Dim sld As Slide
    Dim shp As Shape
    
    ' スライド内に表が あるスライドを保存
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTable Then
                sh_has(sh_cnt) = True
            Else
                sh_has(sh_cnt) = False
            End If
            sh_cnt = sh_cnt + 1
            Exit For
        Next shp
    Next sld
    
    'ファイル取得
    point_stg = File_load
    
    ' ファイルが見つかっている状態の場合
    If point_stg <> "Not_fand" Then
        '全スライドに対して
        For s = 1 To s_cnt
             ' 表があるか確認
            If sh_has(s) Then
                ' 1番の表をcsvファイルの内容で更新
                With ActivePresentation.Slides(s).Shapes(1).Table
                    ReDim cells(1 To .Rows.Count, 1 To .Columns.Count)
                    point = Split(point_stg, ",")
                    For c = 1 To .Columns.Count
 _
                        .Cell(2, c).Shape.TextFrame.TextRange.Text = point(c - 1)
                    Next c
                End With
            End If
        Next s
    End If
    Exit Sub
    
End Sub

'スライドが移動したらpointを呼ぶ
Sub OnSlideShowPageChange(ByVal ss As SlideShowWindow)
  Dim n As Long
  n = ss.View.CurrentShowPosition
  Select Case n
    Case n
        point
    Case Else
  End Select
End Sub

'スライド1のタイトルをファイルパスとし て取得し、内容を読み込む
Function File_load()
    On Error GoTo ERR_HNDL
    Dim csv_path As String
    csv_path = ActivePresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text
    Dim buf As String
    Open csv_path For Input As #1
        Do Until EOF(1)
            Line Input #1, buf
        Loop
    Close #1
    File_load = buf
Exit Function
    
ERR_HNDL:
    MsgBox " ファイルが見つかりませんでした"
    File_load = "Not_fand"
End Function
```

#ソースの解説

#### ファイルの読み込み
```vba:ファイル読み込み
'スライド1のタイトルをファイルパスとし て取得し、内容を読み込む
Function File_load()
    On Error GoTo ERR_HNDL
    Dim csv_path As String
    csv_path = ActivePresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text
    Dim buf As String
    Open csv_path For Input As #1
        Do Until EOF(1)
            Line Input #1, buf
        Loop
    Close #1
    File_load = buf
Exit Function

ERR_HNDL:
    MsgBox " ファイルが見つかりませんでした"
    File_load = "Not_fand"
End Function
```

スライド1を非表示スライドに設定してスライド1のタイトルに入力された文字列をファイルパスとして取得するようにした。
ソースコードに直接書いてもよかったが、後からファイルのパスを変更できた方が良いという判断からこうした。
読み込んだcsvファイルの１番下の行を文字列を文字列として読み込み返す。
ファイルが見つからなかった場合はエラーを示す、"Not_fand"を返す。
ファイルを読み込むとMacOSだとではファイルアクセスの許可を求められるので許可する。
(多分Windowsでも)


#### スライド移動時
```vba:スライド移動時にpointを更新する関数を呼ぶ
'スライドが移動したらpointを呼ぶ
Sub OnSlideShowPageChange(ByVal ss As SlideShowWindow)
  Dim n As Long
  n = ss.View.CurrentShowPosition
  Select Case n
    Case n
        point
    Case Else
  End Select
End Sub
```
スライド移動時に、得点更新用の関数呼ぶ。

#### 得点の更新
```vba:スライドの移動時、もしくは手動で実行された場合に呼ばれる
Sub point()
    
    DoEvents

    Dim os As String

    Dim cells() As String  ' 表内の文字列格納用配列
    Dim s_cnt As Long   ' スライド数格納用
    Dim r As Long       ' 行方向ループのカウンタ
    Dim c As Long       ' 列方向ループのカウンタ
    Dim s As Long       ' スライドループのカウンタ
    
    Dim sh_cnt As Long 'shpを持っているかを確認するカウンタ
    Dim sh_has() As Boolean 'shp を持っているか
    
    Dim point_stg As String 'csvの中身
    Dim point() As String 'csv の中身を分割したもの
    
    s_cnt = ActivePresentation.Slides(ActivePresentation.Slides.Count).SlideNumber ' スライドの総数を取得
    
    ReDim sh_has(1 To s_cnt)
    
    sh_cnt = 1
    
    Dim sld As Slide
    Dim shp As Shape
    
    ' スライド内に表が あるスライドを保存
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTable Then
                sh_has(sh_cnt) = True
            Else
                sh_has(sh_cnt) = False
            End If
            sh_cnt = sh_cnt + 1
            Exit For
        Next shp
    Next sld
    
    'ファイル取得
    point_stg = File_load
    
    ' ファイルが見つかっている状態の場合
    If point_stg <> "Not_fand" Then
        '全スライドに対して
        For s = 1 To s_cnt
             ' 表があるか確認
            If sh_has(s) Then
                ' 1番の表をcsvファイルの内容で更新
                With ActivePresentation.Slides(s).Shapes(1).Table
                    ReDim cells(1 To .Rows.Count, 1 To .Columns.Count)
                    point = Split(point_stg, ",")
                    For c = 1 To .Columns.Count
 _
                        .Cell(2, c).Shape.TextFrame.TextRange.Text = point(c - 1)
                    Next c
                End With
            End If
        Next s
    End If
    Exit Sub
    
End Sub
```
もう少し関数に分けるなどをすれば、よかった。
基本的にはコメントに書いてある通りで、ファイルが見つかった場合、表番号1番の内容を、csvファイルのから取得した文字列で順番に書き換えていく。
パワポでは表を作ると番号振られているようがどれが何番になるのかは、わからないので1スライドにつき1つの表にするのが安全。

本当は表示中のスライドのみを表があるのか判定して、更新するのが良いが、気がつくの遅かったのと、パワポは複数ディスプレイでスライドショーをしていると、次のスライドの内容が操作している人には見えるので、得点が更新されていないように見えることから、今回は修正しなかった。

#ボタンの作成

<img width="472" alt="スクリーンショット 2019-04-27 9.43.41.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/1802ece7-47f9-6078-418c-4a298d174f81.png">

後はスライドを移動しないと得点が更新されないのは、不便なので、手動でも更新できるように図形の挿入で動作設定ボタンを入れる。マクロ実行を選んで、実行するマクロは"point"を選択。カーソルが通過するだけでOKにするのか、クリックするのかは目的に合わせて変更。
<img width="430" alt="スクリーンショット 2019-04-27 9.47.00.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/c9403593-93e5-eb1d-8573-4d57dc5536c4.png">

ボタンがこのままだとボタンがスライドショー中に見えてカッコ悪いのでボタンを図形の書式設定から透明かする。(ボタン位置が見えなくなるので位置覚えておく、位置を右下の角に置くなど分かりやすくする)

<img width="429" alt="スクリーンショット 2019-04-27 9.53.22.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/389514/bab01ee2-cca3-cca9-c4fe-33395e674075.png">

#定時実行について
冒頭にもある通り本来定時実行が望ましいが、excelにはあるApplication.OnTimeがパワポにはなかった。AppleScriptなどと繰り合わせて作るなどといった方法もあるが、そこまでの気力はなかったので、今回は諦めた。