今回も会員様からのご質問です。
「パワポのスライドにワードアートなどを使って複数の文字列を配置しました。それをExcelに用意したリストの中からランダムで選択して置き換えたい。置き換える文字は重複しないように選択してほしい。」
イメージとしては下のようなものです。
VBAを使ってエクセルを呼び出し、繰り返し文を使って、エクセルに用意したリストからランダムで選択し、文字列を置き換えればよさそうですね。
ちょっと長いコードになりそうですが、パワーポイントのVBAを作ってみましょう。
1，事前準備
■ PowerPointの確認
変更したい文字列を含むPowerPointでは、文字列がオブジェクトとして登録されているのを確認します。
❶ 任意の文字列が入力されているオブジェクトを選択
❷ 「図形の形式」タブが表示されるので選択、「オブジェクトの選択と表示」をクリック
❸ 右側に複数のオブジェクトリストが表示るのを確認。
■ Excelの確認
対象のPowerPointと、データリストが登録されたエクセルは同じフォルダに格納します。
フォルダ内に格納したExcelを立ち上げます。
今回は任意の名前のファイル名、シート名のA列に置き換えたい文字列を必要な数だけ登録します。ファイル名とシート名はこの後VBAで使用します。
サンプルではファイル名「DT.xlsx」、シート名「Sheet1」にしています。
文字列のデータはいくつでも構いません。サンプルでは都道府県名を登録してみました。
2，コードの作成
PowerPointで開発タブを表示、または「Altキー」+ 「F11」でVisualBasicを立ち上げます。標準モジュールを追加して、以下のコードを入力します。
まずは重複した場合に True を返す関数を作成します。
'使用済みかどうかを判定する関数
Function IsUsed(usedKenmei As Collection, kenmei As String) As Boolean
Dim i As Variant
On Error Resume Next
For Each i In usedKenmei
If i = kenmei Then
IsUsed = True
Exit Function
End If
Next i
IsUsed = False
End Function続いて都道府県名を置き換える関数を作成します。
Sub Replace()
Dim ppApp As Object 'PowerPointアプリケーション用の変数
Dim ppSlide As Object '現在のスライド用の変数
Dim ppShape As Object 'スライド上の各Shape用の変数
Dim xlApp As Object 'Excelアプリケーション用の変数
Dim xlBook As Object 'Excelブック用の変数
Dim xlSheet As Object 'Excelシート用の変数
Dim nameList As Collection 'リストを格納するためのCollection変数
Dim usedKenmei As Collection '使用済みの県名を格納するのCollection変数
Dim i As Long 'くり返し用変数
Dim randIndex As Long 'ランダムなインデックスを格納する変数
Dim currenPath As String '基準となるフォルダパス
'PowerPointアプリケーションを取得
Set ppApp = GetObject(, "PowerPoint.Application")
Set ppSlide = ppApp.ActiveWindow.View.Slide 'アクティブスライドを取得
'現在のPowerPointファイが保存されているフォルダ
currenPath = ppApp.ActivePresentation.Path
'Excelを開く
Set xlApp = CreateObject("Excel.Application") 'ExcelApplication作成
xlApp.Visible = False 'Excelを非表示モードに
'❶相対パスを利用してExcelファイルを開く
Set xlBook = xlApp.Workbooks.Open(currenPath & "\DT.xlsx")
Set xlSheet = xlBook.Sheets("Sheet1") 'シート名「Sheet1」を指定して取得
'ExcelのA列のデータを収集してnameListに登録する処理
Set nameList = New Collection 'Collection型のインスタンスを作成
On Error Resume Next 'エラーが発生してもスキップ
'A列のデータを最後の行までループ（-4162はxlUp）
For i = 1 To xlSheet.Cells(xlSheet.Rows.Count, "A").End(-4162).Row
nameList.Add xlSheet.Cells(i, "A").Value 'A列の各値をCollectionに追加
Next i
On Error GoTo 0 'エラーハンドリングをリセット
'使用済み県名を追跡するためのCollectionを作成
Set usedKenmei = New Collection
'スライド内のテキストオブジェクトをランダムに置き換える
Randomize 'Rnd関数の乱数シードを初期化
For Each ppShape In ppSlide.Shapes 'スライド内の全てのShapeをループ
If ppShape.HasTextFrame Then 'ShapeがTextFrameを持っている場合
If ppShape.TextFrame.HasText Then 'TextFrameがテキストを含む
'テキストが空でない場合
If ppShape.TextFrame.TextRange.Text <> "" Then
'未使用の県名を取得する
Do
randIndex = Int((nameList.Count) * Rnd + 1)
Loop While IsUsed(usedKenmei, nameList(randIndex))
'県名を使用済みリストに追加
usedKenmei.Add nameList(randIndex)
'ランダムに選ばれた県名でテキストを置き換え
ppShape.TextFrame.TextRange.Text = nameList(randIndex)
End If
End If
End If
Next ppShape '次のShapeに進む
'Excelを終了
xlBook.Close False 'Excelブックを保存せずに閉じる
xlApp.Quit 'Excelアプリケーションを終了
MsgBox "県名を置き換えました。" '処理完了のメッセージを表示
End Subこのファイルを保存する際には、PowerPointの拡張子をマクロ有効プレゼンテーション（.pptm)に置き換えます。
3，運用
1，事前にExcelファイルの任意のシート、A列に置き換えたいデータを登録します。
2，PowerPointでVBAを立ち上げ、上で作成したExcelのファイル名、シート名を指定します。
上のVBAの❶の青色部分で指定したファイル名、シート名を修正
Set xlBook = xlApp.Workbooks.Open(currenPath & "\DT.xlsx")
Set xlSheet = xlBook.Sheets("Sheet1")3,PowerPointの文字を置換したいスライドをActive（開いている）状態にして、VBAを立ち上げ、Replace()関数を呼び出します。
文字列が置き換わっているのを確認できたと思います。
ファイブボックスでは、PowerPoint、Excelの使い方やマクロの作成、その他プログラミング言語の学習やスクラッチやUnityの個別指導のオンラインレッスンを行っています。
Comments