図を差し替えたいだけなんじゃ～！！！

f:id:elve:20210801071418p:plain
はい、こんな封筒データが有ったとします。個人情報は疑似個人情報データ生成サービスで生成した偽情報です。
季節が変わったので図を差し替えて欲しいと言わたとしますよー。毎月画像差し替えです。
そんじゃドキュメントと同じフォルダにある、一番新しいpngファイルに差し替えるマクロを組みましょう、と。

図のサイズは一緒
図はヘッダーにある
図の名前は”図 12”

f:id:elve:20210801055707p:plain

手動でやるなら図を選択して調整から「図の変更」するだけじゃん？　なんか簡単そうじゃん？

・図の変更のコードはマクロの記録で得られませんし、２０１０版VBAヘルプを探してもみつけられません。
https://answers.microsoft.com/ja-jp/msoffice/forum/all/excel-2007-vba/48b2e8a6-ad64-41bc-8ebf-a299e7bf04f8

えええええええええええええ(´；ω；｀)

んで、ザクザクーっと書くと

Function get_newestFile(t As String) As String
    '指定拡張子の最新ファイル名取得
    If Len(t) > 4 Then
        get_newestFile = ""
        Exit Function
    End If
    Dim p As String: p = Me.Path & "\"
    Dim newest As Date
    Dim filename As String
    Dim taegetname As String
    filename = Dir(p & "*." & t)
    
    Do Until filename = ""
        If FileDateTime(p & filename) > newest Then
            newest = FileDateTime(p & filename)
            taegetname = filename
        End If
        filename = Dir()
    Loop
    get_newestFile = taegetname
End Function
Sub 図差替()
    Dim p As String: p = Me.Path & "\"
    Dim se As Section
    For Each se In Me.Sections
        Dim he As HeaderFooter: Set he = se.Headers(wdHeaderFooterPrimary)
        Dim sh As Shape: Set sh = he.Shapes("図 12")
        Dim filename As String: filename = get_newestFile("png")
        Dim newsh As Shape
        Set newsh = he.Shapes.AddPicture(p & filename, False, True, sh.Left, sh.Top, sh.Width, sh.Height)
        sh.Delete
        newsh.Name = "図 12"
    Next
End Sub

で、実行するじゃない
f:id:elve:20210801063039p:plain
どこいった・・・*1
図の位置が相対的なのになってるとうまく行かないのかな？←よくわかってない。
修正したらこんな感じ

Function get_newestFile(t As String) As String
    '指定拡張子の最新ファイル名取得
    If Len(t) > 4 Then
        get_newestFile = ""
        Exit Function
    End If
    Dim p As String: p = Me.Path & "\"
    Dim newest As Date
    Dim filename As String
    Dim taegetname As String
    filename = Dir(p & "*." & t)
    
    Do Until filename = ""
        If FileDateTime(p & filename) > newest Then
            newest = FileDateTime(p & filename)
            taegetname = filename
        End If
        filename = Dir()
    Loop
    get_newestFile = taegetname
End Function
Sub 図差替()
    Dim p As String: p = Me.Path & "\"
    Dim se As Section
    For Each se In Me.Sections
        Dim he As HeaderFooter: Set he = se.Headers(wdHeaderFooterPrimary)
        Dim sh As Shape: Set sh = he.Shapes("図 12")
        Dim filename As String: filename = get_newestFile("png")
        Dim newsh As Shape
        Set newsh = he.Shapes.AddPicture(p & filename, False, True, , , sh.Width, sh.Height)
        With newsh
            .WrapFormat.Type = sh.WrapFormat.Type
            .RelativeHorizontalPosition = sh.RelativeHorizontalPosition
            .LeftRelative = sh.LeftRelative
            .RelativeVerticalPosition = sh.RelativeVerticalPosition
            .TopRelative = sh.TopRelative
            .Top = sh.Top
            .Left = sh.Left
            .LockAnchor = sh.LockAnchor
        End With
        sh.Delete
        newsh.Name = "図 12"
    Next
End Sub