スナックelve 本店

バツイチ40代女の日記です

差し込み印刷-2-

snack.elve.club
パワポ
f:id:elve:20210606095733p:plain
これの該当部を置換して指定枚数印刷。(面倒になったので保存すらしないw)

  1. テンプレファイルを開く
  2. スライド内のシェイプの文字列置換
  3. 印刷
  4. テンプレを保存しないで閉じる

を繰り返すことにします。(担当者30名ほどなのでこれで行けましたがもっと多いなら、ファイル操作は少なくしたほうが良いような気がします。なんとなく)

ファイルは

  • 差込用リスト.xlsm
  • 挨拶文差込.pptx

エクセルはこんな感じでここから実行
f:id:elve:20210606064502p:plain

スライド1枚、テキストボックス2個のシンプルなパワポなんで力技で・・・
なーんかもっといい方法あるとおもうんだけどなぁ・・・(プレゼンテーションの一括置換あるし)
マクロの記録させてくれよ、パワポ!!

Sub パワポ処理()
'パワポの準備
Dim app As PowerPoint.Application: Set app = CreateObject("PowerPoint.Application")
app.Visible = True
'担当者情報
Dim i As Integer
Dim 担当者数 As Integer: 担当者数 = Worksheets("担当者").Range("A1").End(xlDown).Row
Dim 担当者: 担当者 = Worksheets("担当者").Range("A1").CurrentRegion

For i = 2 To 担当者数
'テンプレート読み取り専用で開く
    Dim pre As PowerPoint.Presentation: Set pre = app.Presentations.Open("F:\20210606_差込\挨拶文差込.pptx", msoTrue)
'スライド1固定
    Dim sld As PowerPoint.Slide: Set sld = pre.Slides(1)
    Dim shp As PowerPoint.Shape
'テキストボックスしかないから判定しない
    For Each shp In sld.Shapes
        With shp.TextFrame.TextRange
'TextRangeでReplaceするとフォント変わっちゃうので・・・
            Dim t As String
            t = .Text
            t = Replace(t, "<担当(フルネーム)>", 担当者(i, 1))
            t = Replace(t, "<担当者(名字)>", Left(担当者(i, 1), InStr(担当者(i, 1), " ") - 1))
            .Text = t
        End With
    Next
'印刷
    pre.PrintOut copies:=担当者(i, 2)
    Set sld = Nothing
    
    pre.Saved = True
    pre.Close
    Set pre = Nothing
Next
app.Quit
Set app = Nothing
End Sub

参考サイト