1 スライドにつき、1 コピーを掲載していく PowerPoint を作る機会がありました。

100スライド程度なら手作業でもそんなに時間かからないと思うんですが、コピーが 3,000 以上来る予定で、修正も考えるともっとです。

かつ、コピーライティング上必要な改行が入っていたりするので、Excel ではセルを開いてコピーする必要があります。（そうしないと前後にダブルクォーテーション["]が付いてしまい、あとあと消していくのも面倒です。）

そんなこんなで手作業でやるには時間が無駄すぎたので久々VBA組みました。

前提

元のコピーは Excel 上に 1コピー1セルの形で格納してあります。
あとあとスタイルを一括整形するのにスライドマスタを使えると楽なので、タイトルシェイプに入れていくことにしました。（タイトルシェイプに入れておけばスライドマスタでスタイルを一括変換できます。）

また、この VBA は Windows版 Office365 で作成しています。（Macでは検証してません。）

Excel の状態

形式はなんでもいいのですが、 1コピー1セル の形で格納されているものとします。
今回は全てを採用しない可能性を考えて、「採用」列を作り、そこに 優先度 を数字入力したものをフィルタする想定にしています。
内容は適当に作りましたが ↓ こんなイメージです。

このようにフィルタした状態で、対象セルを一括選択する想定です。
（この画像の場合 B2 〜 B27 を選択するイメージ）

VBA

VBAの全体像は ↓ こんな感じです。非常にシンプル！

Sub ExcelToPowerPoint()
Dim pp, ps, sl As Object
Dim i, rowCount As Long
Dim r, c As Object
Dim rng As Range

' 選択範囲のうち表示されているセル範囲のみ取得
Set rng = Selection.SpecialCells(xlCellTypeVisible)
' PowerPoint オブジェクト作成
Set pp = CreateObject("PowerPoint.Application")
With pp
    ' PowerPoint 表示
    .Visible = True
    ' PowerPoint ファイル新規作成
    Set ps = .Presentations.Add
    ' 選択範囲の行でループ
    For Each r In rng.Rows
        ' 選択範囲の列でループ
        For Each c In r.Columns
            With ps.Slides
                ' スライドを（タイトルのみレイアウトで）追加
                Set sl = .Add( _
                    Index:=.Count + 1, _
                    Layout:=11)
                ' タイトルシェイプにループ時のカレントセルの内容を挿入
                sl.Shapes(1).TextFrame.TextRange.Text = c.Text
            End With
        Next c
    Next r
    ' オブジェクトをクリア
    Set sl = Nothing
    Set ps = Nothing
End With
Set pp = Nothing
End Sub

これを Excel VBA の標準モジュールとして登録します。

VBAの流れ解説

選択範囲のうち表示されているセル範囲情報を取得
PowerPoint オブジェクト生成
PowerPoint 表示
PowerPoint ファイル新規作成
選択範囲の行と列でループ処理
PowerPoint スライド（タイトルのみレイアウト）を追加
タイトルシェイプにセルの内容を設定
選択範囲分6,7を繰り返す

できたPowerPoint

↓こんな感じのが一瞬でできました。

改行もちゃんと反映されてます。

まとめ

今回作ったものは需要が少ないですが、VBAはやっぱり便利だなと思いました。

** 注意 **
VBA はバージョンやOS環境によって挙動が異なるので、
利用される場合は自己責任でお願いします🙏