【word VBA】ドキュメント内の画像・シェイプをフッターにコピー

Question

ドキュメント内に配置した画像やシェイプを別のファイルのフッターにコピーしたいと
考えております。（シェイプは規定のものがあり、新たに作成したくない）

手始めに自ドキュメントのフッターへのコピーの為、以下を試しましたが、
word自体がエラーして停止してしまうようです。

Sub test()

ActiveDocument.Shapes("img").Select
Selection.Copy
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Select
Selection.PasteAndFormat (wdPasteDefault)

End sub

また、以下の方法も試しましたが、すでにドキュメント内にあるシェイプを指定する方法が
分かりませんでした。

インストラクターのネタ帳 様
https://www.relief.jp/docs/word-vba-add-shape-header.html

sub test2()

  Dim shp As Shape

  Set shp = _
    ActiveDocument _
        .Sections(1).Footers(wdHeaderFooterPrimary) _
        .Shapes.AddPicture( _
            fileName:="C:\Users\img.png", _
            Left:=5, Top:=5, _
            Width:=100, Height:=50)

End sub

ご教示の程、よろしくお願いいたします。

Answer 1

Word2016でもShapeとして操作すると、Wordが終了することがありましたが、
以下のようにInlineShapeとして操作すると上手くいきました。

もっと良い方法はありそうな気がしますが……

Sub teratail_Q152756()
'https://teratail.com/questions/152756
    
    '図形のコピー
    Dim srcDoc As Word.Document
    Set srcDoc = ThisDocument
    
    'Shapeだと挙動が怪しかったため（Wordが強制終了しやすい）、
    '複製してInlineShapeに変換してからコピペ
    Dim tmpInlnShp As Word.InlineShape
    Set tmpInlnShp = srcDoc.Shapes.Item("img").Duplicate().ConvertToInlineShape()
    
    tmpInlnShp.Select
    srcDoc.ActiveWindow.Selection.Copy
    tmpInlnShp.Delete 'ゴミ掃除
    
    
    '貼り付け
    Dim destDoc As Word.Document
    Set destDoc = Documents.Add()
    
    Dim primaryFooter As Word.HeaderFooter
    Set primaryFooter = destDoc.Sections.Item(1).Footers.Item(wdHeaderFooterPrimary)
    primaryFooter.Range.Paste
    
    With primaryFooter.Range.InlineShapes
        Dim pasetedShp As Word.InlineShape
        Set pasetedShp = .Item(.Count)
    End With 'primaryFooter.Range.InlineShapes
    
End Sub

Comments

[TNF_1023]

回答ありがとうございます。
InlineShapeに変換するとのこと、大変参考になりました。
こうした発想も参考にさせていただきます。

Answer 2

Free Spire.Doc for .NET
この製品にはフッターに画像を挿入する機能があります。
無料版があります。
https://www.e-iceblue.com/Tutorials/Spire.Doc/Spire.Doc-Program-Guide/Word-Header/Footer-Insert-Image-Header-and-Footer-for-Word.html

Imports System.Drawing
Imports Spire.Doc
Imports Spire.Doc.Documents
Imports Spire.Doc.Fields

Namespace ImageHeaderFooter
    Friend Class Program
        Shared Sub Main(ByVal args() As String)
            'ドキュメントのロード
            Dim document As New Document()
            document.LoadFromFile("E:\Work\Documents\Spire.Doc for .NET.docx")

            'Footerインスタンスの初期化
            Dim footer As HeaderFooter = document.Sections(0).HeadersFooters.Footer
            'フッターに段落と書式設定を追加する
            Dim paragraph2 As Paragraph = footer.AddParagraph()
            paragraph2.Format.HorizontalAlignment = HorizontalAlignment.Left
            'フッター段落に画像とテキストを追加する
            Dim footerimage As DocPicture = paragraph2.AppendPicture(Image.FromFile("E:\Logo\logo.jpeg"))
            Dim TR As TextRange = paragraph2.AppendText("Copyright © 2013 e-iceblue. All Rights Reserved.")
            TR.CharacterFormat.FontName = "Arial"
            TR.CharacterFormat.FontSize = 10
            TR.CharacterFormat.TextColor = Color.Black

            document.SaveToFile("ImageHeaderFooter.docx", FileFormat.Docx)
            System.Diagnostics.Process.Start("ImageHeaderFooter.docx")
        End Sub
    End Class
End Namespace