ExcelからPowerPointのスライドを開き指定ページのオブジェクトに文字列をセットする

知恵袋の質問
detail.chiebukuro.yahoo.co.jp

＞毎月の従業員人数や、部署の人数など、更新箇所が少なくとも7か所あり、
＞さらにリーフレットは9種類もあるため、7×9=63か所を
＞ちまちまと毎月更新しないといけないみたいです。
＞私としては、何か元となるファイルを更新したら63か所が一気に更新される！

にチャレンジしてみた

1.リーフレット9種類文、パワポファイル分シートを作成する

2.ページとオブジェクトを調べ、セットする従業員人数や、部署の人数

簡単な仕様

1.B2に入力されたPowerPointファイルを開き
2.先頭行A5のデータから
A列:指定ページ内の B列:オブジェクトに C列:文字列をセットする

添付画像のイメージでデータをセットしてみました
https://www.youtube.com/live/VUw8a-xW55w?si=CyhpDt2hUR-tO7kk&t=251
↑のテスト動画です、※倍速で流してみてください。
これで、毎月の更新処理ができそうなら、
下記のソースコードを使ってみてください。

'ソースコード:

'B2に入力されたPowerPointファイルを開き
'先頭行A5のデータから
'A列:指定ページ 内の B列:オブジェクト に C列:文字列をセットする
Sub パワポに文字列をセットする20230912()

    'PowerPointアプリの起動
    Dim ppApp As Object   'PowerPoint.Application
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True '可視にする
    DoEvents

    'B2ファイルを開く
    Dim strPPFName As String
    strPPFName = Range("B2")  'B2に記載されたファイルを開きたい
    
    '開く、変数に入れる
    Dim ppセット先 As Object  'PowerPoint.Presentation  'pp:プレゼンテーション
    Set ppセット先 = Nothing '初期化、エラーチェックもかねて
    On Error Resume Next   '↓でSet 取得エラー時に次へ ファイルが開けなかった時
    Set ppセット先 = ppApp.Presentations.Open(strPPFName) '開く
    DoEvents
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
    '↑単純に、.Open "ファイル名" で開いただけです
    If ppセット先 Is Nothing Then '↑上で開けたか？
        'openエラーの時、開けなかったことを知らせる
        MsgBox strPPFName & "が開けません確認してください", vbExclamation
        Exit Sub  'んっ？空のppAppが残るか、これだと・・・
    End If

    'A列:指定ページ 内の B列:オブジェクト に C列:文字列をセットする
    Dim p As Integer, y As Integer   'pページ、y行
    Dim strShpName As String  'シェイプの名前
    
    Dim ppShape As Object  'As PowerPoint.Shape パワポのシェイプ、テキスト、図形ほか
    
    y = 5  '4行目が見出しなので、5行目 A5からデータをセットする
    While Len(Cells(y, "A")) <> 0 'A列の文字数が0以外の間ループ、A列がなくなるまで
        
        p = Cells(y, "A")          'A列からスライド番号(ページ番号)
        strShpName = Cells(y, "B") 'B列から オブジェクトの名前
        
        Set ppShape = Nothing  '初期化
        On Error Resume Next  '取得エラー時に次へ行く
        'pページのスライド内のシェイプ A列のページ と B列の名前を使う
        Set ppShape = ppセット先.Slides(p).Shapes(strShpName)
        On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
        
        If ppShape Is Nothing Then  '名前のエラーチェック
            MsgBox p & "ページ:" & strShpName & "が見つかりません、確認してください"
            Exit Sub
        End If
        
        'やっと文字列 C列の値をセット .Value ではなく .Textを使用してみた
        ppShape.TextFrame.TextRange.Text = Cells(y, "C").Text  'C列の文字列をセット
        
        y = y + 1   '次の行 データへ
            
    Wend
    
   
    MsgBox "処理終了？確認してね"

End Sub