Microsoft365

HOME
Microsoft365
PowerPointの画像や動画をランダムに入れ替えたい

2020年1月28日 / 最終更新日時 : 2025年8月9日 officeの杜 Microsoft365

PowerPointの画像や動画をランダムに入れ替えたい

以前、PowerPointでデジタルサイネージを作り、様々な情報をローコストで社内で配信する環境を作りました。PowerPoint自体は静的なスライドをただただ垂れ流すだけなので、VBAを使って動的に情報をリアルタイムに取得・生成する仕組みにする事で、高価なサイネージ装置など使わずとも、サイネージは十分実現が可能です。

今回は、特定のフォルダ内にある画像を特定のスライドにランダムに差し替えるものを実装します。風景チャンネルを作って欲しいという事だったのですが、何百枚もスライド作るのは現実的ではないので、VBAで操作してみたいと思います。

今回使用するパワーポイントファイル

ランダムスライドショー for PowerPoint

コード編集時は注意が必要です。コードを編集する事で、スライドショー起動時に取得したcntおよびarraymanの中身がクリアされてしまうので、一旦閉じて再度開き直してから、スライドショー実行する必要があります。

事前準備

前回同様、パワポを作るにあたって、色々と事前準備を行います。

ワイド画面対応にする

通常、PowerPointでファイルを作成すると昔のアニメのように4:3で作成されてしまいます。しかし、最近のモニターは16:9で構成されていることが多く、そのままでは画面の両端に黒い帯が出来てしまい、格好が悪い。まずは作り始める前にPowerPointのスライドサイズを16:9のワイド画面対応にしましょう。

デザインタブを開く
スライドのサイズを開く
ワイド画面（16:9）を選択する

図：16:9を使うようにしましょう

VBAを有効にしたpptmファイルにする

今回は動きのある動的なデジタルサイネージコンテンツとするため、ただの紙芝居ではなくVBAを利用するため、今回のファイルはpptx形式ではなく、pptm形式で保存してあげる（でないと、VBAコードを書いても排除されてしまいます）。

ファイルタブを開く
名前を付けて保存を選択する
参照をクリックして保存先を選択
その際のファイルの種類について「マクロ有効プレゼンテーション」を選ぶ
保存ボタンを押す

起動時にセキュリティ警告が出ることがありますが、コンテンツの有効化をクリックしてもらえれば問題ありません。

配置したテキストボックスの名前を調べる

VBAで動的にテキストボックスの値を書き換えたりするのが今回の目的の１つですが、PowerPoint上の各種パーツには表向きプロパティが見えません。しかし、これらのコントロール名が分からなければ、書き換えようがありません。実は表向き見えないだけで、各パーツ類にはきちんと自動でコントロール名が与えられている。

このコントロール名を以下のVBAで事前に調べておき、VBA内で指定して内容を書き換えます。ちなみにこのコントロール名はスライド単位であり、スライドをコピーするとコントロール名も同じ名前のままです。ファイル内では同じコントロール名のボックスがあることになりますが、スライド単位で指定するので、問題なくアクセスが可能です。

対象のパーツをクリックする
以下のコマンドを実行する。
パーツの名前とIDが返ってくるので、控えておく。

'現在選択中のシェイプパーツの名前を取得するコマンド
Public Sub getActiveShapeName()

  Dim shp As Shape

  With ActiveWindow.Selection

    If .Type = ppSelectionNone Or _
      .Type = ppSelectionSlides Then Exit Sub

    For Each shp In .ShapeRange
      Debug.Print shp.Name
      Debug.Print shp.Id
    Next shp

  End With

End Sub

OnSlideShowPageChangeのバグ対策

PowerPoint VBAを利用する上でぶつかる問題の１つに「スライド変更時にVBAを実行させる」特別なイベントにコードを書いても動かない事がある点です。2013の頃からあるバグで、OnSlideShowPageChangeという関数名で作るとそれが実行可能になっています。スライドの何枚目に来たら実行するのがポピュラーな使い方です。

VBAが実行されない理由はVBAプロジェクト画面にて、標準モジュールしかなく、対象のスライドが見えないというPowerPoint特有の問題があります。この問題の簡単な解決法はどのスライドでも良いので、適当にフォームコントロールを入れてあげること。こうする事でOnSlideShowPageChangeのメソッドがきちんと働くようになります。

適当なスライドを選択する
開発タブを開く（表示されていない場合には表示しておきましょう）
ラベルコントロールなどの適当なコントロールを張り付ける
Visual Basicを開く
プロジェクトにSlide〇〇があればOKです。上書き保存しましょう。

図：プロジェクトにSlideがいるのを確認しましょう。

画像の準備

VBAの入ってるPowerPointファイルと同じフォルダ内に「images」というフォルダを作成し、中に適当な画像ファイルを詰め込んで置きます。プログラムは起動時に、このフォルダ内の画像ファイルのパスを配列として格納し、乱数で取り出し差し替えるという仕組みになっています。画像以外のものが混じっているとプログラムが止まりますので要注意。

図形の準備

今回の肝。実はPowerPointで画像の差し替え用のメソッドというものはありません。ただ、VBAとしてImageコントロールを配置した場合には、LoadPictureにて画像のソースを変更出来るとあったのですが、PowerPointではなぜか動かず（UserFormじゃないと動かないのかな）。また、画像を挿入しておいて、そのshapeの画像の入れ替えも頑張ってみましたが、メソッドがないので出来ず。

そこでスライドに何を用意するかと行ったら、図形の四角形（Rectangle）を用意します。これは画像表示用ではないのですが、「背景塗りつぶしで画像が使える」ので、これを利用します。メソッドに「塗りつぶし背景画像の指定」があるので、これで入れ替えるようにします。

図：図形パーツを使うというのがポイント

ソースコード

今回のプログラムでは、スライドショーを開く時イベントである「SlideShowBegin」を使う為、空のリボンを追加します（アドイン形式も出来るけれど、そちらのほうが面倒なので）。

リボンのコード

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="OnLoadman">

</customUI>

Custom UI Editorを使って作ると楽に作れます。
onLoadにOnLoadmanという関数を指定。これがとても重要です。
アドインの場合には、Public Sub Auto_Open()にて自動実行をさせる事ができますが、今回はアドイン無しなので使いません。

VBA側のコード(Class1)

SlideShowBeginは、クラスモジュールでなければ作れないので、クラスを追加して以下のようなコードを書きます。スライドショー実行時の1回だけ実行されますが、事前にOnLoadmanで初期化されていないと使えないので、其のためにリボンで自動初期化させています。

Option Explicit

Public WithEvents PPTEvent As Application
 
'スライドショー実行時に自動実行
Private Sub PPTEvent_SlideShowBegin(ByVal Wn As SlideShowWindow)
    
    '指定フォルダ
    Dim Path As String
    Path = ActivePresentation.Path & "\images\"
    
    'フォルダ内のファイルの数を取得する
    Dim fileName As String
    Dim cnt As Integer
    cnt = 0
    fileName = "*"
    
    Dim tmp As String
    tmp = Dir(Path & "\" & fileName)
    Do While tmp <> ""
        cnt = cnt + 1
        tmp = Dir()
    Loop
    
    '配列を拡張する
    ReDim arrayman(cnt)
    
    '配列にファイル名を流し込む（すべてのファイルを指定）
    Dim buf As String
    buf = Dir(Path & "*.*")
    cnt = 0
    
    Do While buf <> ""
        '配列にファイル名を追加
        arrayman(cnt) = buf
        buf = Dir()
        
        'カウンタを回す
        cnt = cnt + 1
    Loop
    
    'グローバルカウンタに件数を入れておく
    gcnt = cnt

End Sub

グローバル変数としてcntおよびarraymanという配列を標準モジュール側で宣言してあります。
cntは、指定フォルダ内のファイルの総数を格納。arraymanは指定フォルダ内のファイル名を格納します。
本来は、Dir(Path & "*.jpg")とでもして、jpg画像に絞ったほうが良いのですが、あえて*.*で全ファイル指定にしてあります。
スライドショー実行時の1回だけこのコードは実行されます。OnSlideShowPageChangeですと、毎回スライド変更時に動いてしまうので具合が悪い。
最初の1回だけファイル総数とファイル名を取得させておく事で、毎回取りに行く必要がなくなります。
今回はプレゼンファイルの同じフォルダ内にあるimagesフォルダを参照するように、ActivePresentation.Path & "\images\"としています。

VBA側のコード（Module1）

'フォルダ内の画像ファイルパスを格納する為の配列
Public arrayman() As Variant

'フォルダ内のファイルの総数
Public gcnt As Integer

Public m_ribbon As IRibbonUI

'slideshowbeginのクラス
Public cPPTObject As New Class1

'リボン起動時に初期化するコード
Public Sub OnLoadman(ribbon As IRibbonUI)
    'Class1を初期化
    Set cPPTObject.PPTEvent = Application
End Sub


'現在選択中のシェイプパーツの名前を取得するコマンド
Public Sub getActiveShapeName()

  Dim shp As Shape

  With ActiveWindow.Selection

    If .Type = ppSelectionNone Or _
      .Type = ppSelectionSlides Then Exit Sub

    For Each shp In .ShapeRange
      Debug.Print shp.Name
      Debug.Print shp.Id
    Next shp

  End With

End Sub

'1枚目のスライドの時に画像入れ替えを発動
Sub OnSlideShowPageChange(ByVal ss As SlideShowWindow)
  Dim n As Long
  n = ss.View.CurrentShowPosition
 
  Select Case n
    Case 1
       Call changepict
  End Select
End Sub

'画像を入れ替えるコード
Public Sub changepict()
    '乱数を使って配列から画像のパスを取得
    Randomize
    
    '乱数を生成
    Dim cnt As Integer
    cnt = Int(gcnt * Rnd)
    
    '乱数で配列から1つ値を取り出す
    Dim temppict As String
    temppict = arrayman(cnt)

    'パスを生成
    Dim pathman As String
    pathman = ActivePresentation.Path & "\images\" & temppict

    '背景画像を差し替える
    ActivePresentation.Slides(1).Shapes("Rectangle 2").Fill.UserPicture pathman

End Sub

冒頭でClass1のクラスモジュールの呼び込み、グローバル変数のcntおよび配列であるarraymanを定義しています。
OnLoadmanはリボン読み込み時に自動実行として指定した関数です。ここでClassを初期化
changepict関数が実際に図形の背景画像を書き換える関数。乱数を使って0～画像の数まで生成し、それを基準にarraymanから画像のファイル名を取得させています。
最後の行が画像差し替え。Slides()の数値はスライド何枚目か？ShapesはgetActiveShapeNameで取得した図形の名称を指定。
Fill.UserPictureに引数として生成した画像へのパスを渡せばOK.
OnSlideShowPageChangeにて、1枚目が開かれたら画像を差し替えるようにchangepictを呼び出しています。

付記

その後、画像も図形ではなく画像をリンク形式で貼り付けて、動画ファイル同様に.LinkFormat.SourceFullNameにて変更できるか？やってみたところ、できちゃいました。手順としては

画像を埋め込みではなく、リンクで挿入する
パーツの名前をgetActiveShapeNameにて調べておく（例：Picture 4）
画像を差し替える部分のコードは以下のように記述する。スライド番号は何枚目のスライドなのか数値を、シェイプの名前に2.で調べたパーツの名前を入れます。
pathmanは画像へのフルパス
.LinkFormat.Updateを入れないと反映されないので注意

'画像を差し替える２
With ActivePresentation.Slides(スライド番号).Shapes("シェイプの名前")
     .LinkFormat.SourceFullName = pathman
     .LinkFormat.Update
End With

動画ファイルの差し替えもやってみる

単一ファイルの場合

画像だけじゃなく、ビルなどにあるサイネージのように動画も流したい！！そういう要望もあるでしょう。確かにPowerPointは動画の挿入も可能で、入れ替えが不要なのであれば、以下の手順だけで自動再生が出来るようになります。

動画ファイルを普通に挿入する
動画をクリックすると、リボンに「再生」というタブが表示される
開始の項目を「自動」にする

これだけです。該当のスライドに来ると自動的に再生されます。しかし、画像の時同様にたくさんの動画ファイルがあり、ランダムにとなると当然この方法では不可能です。

図：単一ファイルならばすごく簡単

複数ファイルをランダムに差し替えて再生

複数ファイルの場合はVBAでコードを書く必要があります。今回は動画ファイルはプレゼンファイルの同じフォルダ内に作った「movie」というフォルダ内に格納しておきます（形式は.mp4/H.264/AVCを選びました）。movのファイルをXMedia RecodeにてBitrate2500にてエンコしてます。

Windows Media Playerコントロールを埋め込んで再生するやり方もあるようですが、今回は基本機能のみで実装してます。

VBA側のコード(Class1)

Option Explicit

Public WithEvents PPTEvent As Application
 
'スライドショー実行時に自動実行
Private Sub PPTEvent_SlideShowBegin(ByVal Wn As SlideShowWindow)
    
    '指定フォルダ
    Dim path As String
    path = ActivePresentation.path & "\movie\"
    
    'フォルダ内のファイルの数を取得する
    Dim fileName As String
    Dim cnt As Integer
    cnt = 0
    fileName = "*"
    
    Dim tmp As String
    tmp = Dir(path & "\" & fileName)
    Do While tmp <> ""
        cnt = cnt + 1
        tmp = Dir()
    Loop

    '配列を拡張する
    ReDim movieman(cnt)
    
    '配列にファイル名を流し込む
    buf = Dir(path & "*.*")
    cnt = 0
    
    Do While buf <> ""
        '配列にファイル名を追加
        movieman(cnt) = buf
        buf = Dir()
        
        'カウンタを回す
        cnt = cnt + 1
    Loop
    
    'グローバルカウンタに件数を入れておく
    mcnt = cnt

End Sub

こちらは画像の時とほとんど変わりません。グローバル変数のmcntおよびグローバル配列movieman()は、Module1側へ記述しています。

VBA側のコード（Module1）

'フォルダ内の動画ファイルパスを格納する為の配列
Public movieman() As Variant

'フォルダ内のファイルの総数（動画）
Public mcnt As Integer

'動画を入れ替えるコード
Public Sub changemov()
    '乱数を使って配列から画像のパスを取得
    Randomize

    '乱数を生成
    Dim cnt As Integer
    cnt = Int(mcnt * Rnd)

    '乱数で配列から1つ値を取り出す
    Dim tempmovie As String
    tempmovie = movieman(cnt)
    
    'パスを生成
    Dim pathman As String
    pathman = ActivePresentation.path & "\movie\" & tempmovie
    
    '動画を差し替える
    'MsgBox pathman
    With ActivePresentation.Slides(スライド番号).Shapes("対象シェイプの名前")
        .LinkFormat.SourceFullName = pathman
        .LinkFormat.Update
    End With

End Sub

'スライドショー実行中にVBA実行する特殊なコマンド
Sub OnSlideShowPageChange(ByVal ss As SlideShowWindow)
    '現在のアクティブスライドを取得する
    Dim n As Long
    n = ss.View.CurrentShowPosition
    
    '指定ページにいったら作動させる
    Select Case n
        Case 1
            '動画のソースを変更
            Call changemov
        Case 8
            '動画を再生する
            Dim plyr As Player
            Dim w As Long, h As Long
            
            '動画ファイルの縦横のサイズを取得
            With ActivePresentation.Slides(8).Shapes("PC302079")
                w = .MediaFormat.SampleWidth
                h = .MediaFormat.SampleHeight
                .Height = h
                .Width = w
                
            End With
            
            Debug.Print "w = " & w & ", h = " & h
            
            '自動再生実行
            Dim itemid As Variant
            itemid = ActivePresentation.Slides(スライド番号).Shapes(対象シェイプの名前).Id
            Set plyr = SlideShowWindows(8).View.Player(itemid)
            plyr.Play
    End Select
    
End Sub

動画ファイルは埋め込みじゃなく、リンク形式で予め１個スライドに入れておく必要があります。
対象シェイプの名前はgetActiveShapeNameにて予め調べておきましょう。動画をクリックしてから手動で実行するだけで取れます。
OnSlideShowPageChangeの1枚目でchangemovを実行し、スライドのリンク先を変更しておく
今回動画は8枚目のスライドに入れてみました。スライド番号は8で、getActiveShapeNameで取得したシェイプ名を入れておく
リンク先の差し替えは、.LinkFormat.SourceFullNameにて行います。フルパスを渡します。
このままだと自動再生されない。ですので、plyr変数にitemidをセットし、plyr.Playにて再生をさせるようにしています。
途中にDebug.Printが入っていますが、これを入れておかないと何故か自動再生が実行されない。動画自体に自動再生の設定を予めしておいても再生されないです。ですので、このDebug.Printはコードとして必要な行です。
今回の手法はローカルの動画ファイルの再生なので、Youtube貼り付けを変更するものではありません。
動画差し替えはサンプルファイルに含まれていません。。

自動ループ再生の設定

自分のプレゼンファイルは以下のような再生設定で無事に動画入れ替えと自動再生が出来るようになりました。

動画のファイル自体に「自動再生」の設定は仕掛けてある。
動画ファイルは再生時は全画面表示に設定してあります。
スライドショーの設定では、種類は「発表者として使用」、オプションは「ESCキーが押されるまで繰り返す」。これで無限ループになります。
画面切り替えでは、全スライド切り替えタイミングは「自動的に切り替え」にて10秒で設定しています。クリック時は外してあります。
画面切り替えはスライド毎にも設定できるので、静止画は少なめに、動画は長めに設定すると良いでしょう。
なお、自動プレゼンテーションの場合のループ再生だとうまく行かないことがあります。

図：スライドショー設定

PowerPointの画像や動画をランダムに入れ替えたい

今回使用するパワーポイントファイル

事前準備

ワイド画面対応にする

VBAを有効にしたpptmファイルにする

配置したテキストボックスの名前を調べる

OnSlideShowPageChangeのバグ対策

画像の準備

図形の準備

ソースコード

リボンのコード

VBA側のコード(Class1)

VBA側のコード（Module1）

付記

動画ファイルの差し替えもやってみる

単一ファイルの場合

複数ファイルをランダムに差し替えて再生

VBA側のコード(Class1)

VBA側のコード（Module1）

自動ループ再生の設定

関連リンク

コメントを残すコメントをキャンセル

Google Apps Scriptでちょっとした顧客管理台帳を作る - GMailアドオン編【GAS】

AppSheetでGoogleスプレッドシート用アプリを作る【GAS】

今回使用するパワーポイントファイル

事前準備

ワイド画面対応にする

VBAを有効にしたpptmファイルにする

配置したテキストボックスの名前を調べる

OnSlideShowPageChangeのバグ対策

画像の準備

図形の準備

ソースコード

リボンのコード

VBA側のコード(Class1)

VBA側のコード（Module1）

付記

動画ファイルの差し替えもやってみる

単一ファイルの場合

複数ファイルをランダムに差し替えて再生

VBA側のコード(Class1)

VBA側のコード（Module1）

自動ループ再生の設定

関連リンク

コメントを残す コメントをキャンセル

Google Apps Scriptでちょっとした顧客管理台帳を作る - GMailアドオン編【GAS】

AppSheetでGoogleスプレッドシート用アプリを作る【GAS】

コメントを残すコメントをキャンセル