WORD ヘッダー、セクションの画像操作をVBA で解決したいです。お願いします。

WORD2016です。
VBAに関しては初心者です。

あるフォルダにある複数の画像をWORDのドキュメント（新規または既存）のヘッダーに１ページに１つずつ挿入し、既定編集することをVBAで解決できないでしょうか？

画像が50個あれば、ページが50ページ必要です。
今、開いているドキュメントが２ページなら、自動的に改ページとセクション区切りを入れてページを増やすイメージです。

挿入後の画像は、縦横比固定、倍率100％、水平垂直ともにページ基準で中央です。

画像のファイル名は都度バラバラですが、リネームせずにそのまま昇順で処理したいです。

現時点では、自分でヘッダーに入り、画像を挿入した状態で、以下の方法で処理しています。

　Sub 画像を等倍率、センター()

　　　With Selection.ShapeRange
　　　.LockAspectRatio = msoTrue

　　　.ScaleHeight 1, msoTrue

　　　 .RelativeHorizontalPosition = _
　　　 wdRelativeHorizontalPositionPage

　　　.RelativeVerticalPosition = _
　　　wdRelativeVerticalPositionPage

　　　 .Left = wdShapeCenter
　　　.Top = wdShapeCenter

　　End With
　End Sub

しかし、画像が多く手間がかかるため何とかならないかと思います。
どうかお願いします。

質問者からの補足コメント

• 

  恐れ入ります。
  背景、透かし、といった用途で画像を使います。
  
  スポーツ少年団の卒団記念の作成です。
  
  子供の活躍した印象深い画像を背景に入れ、本ページには出場した試合、結果、子供が書いた原稿を配置します。１人１ページで卒団者分のページです。（毎年恒例）（お金がないので自作記念品です）
  
  本文と同じ階層にあると、意図せずに画像に触ってしまい位置が移動したり、他の図形などとの上下関係を配慮しなければ選択がままならないのでヘッダーに置きたいと思いました。
  
  返信いただいてありがとうございます。

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/01/03 20:52

No.6 ベストアンサー 回答者： enunokokoro 回答日時： 2019/01/06 15:11

No.4での簡易版にちょっと追加と修正することで、フォルダにある

ファイル数でセクション区切りを追加して、画像を挿入することが
できそうです。
（新規文書から作成する場合）

修正部分（前半部分のみ）

　Dim i,j As Integer
　Dim PIC As Shape
　Dim objFile As Object
　Dim objFldr As Object
　Dim sec As Section
　Dim hd_ft As HeaderFooter

' 画面の更新を止める
　Application.ScreenUpdating = False

　Set objFldr = CreateObject("Scripting.FileSystemObject")
' 画像の数を取得しセクション区切りを挿入
　For j = 1 To objFldr _
　.GetFolder("フォルダのフルパス" & "フォルダ名").Files.Count - 1
　　ActiveDocument.Sections.Add
　Next

' 各セクションのヘッダーで前と同じを解除
　For Each sec In ActiveDocument.Sections
　　For Each hd_ft In sec.Headers
　　　hd_ft.LinkToPrevious = False
　　Next
　Next sec

　i = 0
' 画像フォルダを指定

＝＝＝＝＝以下省略＝＝＝＝＝

この回答へのお礼

これは、非常にありがたいです。
セクション区切りを数えながら増やしていたので、途中でわかんなくなったりしたものですから。
画像もセクションも数えなくてもいいのはありがたいです。
気合を入れないと取り掛かれなかった作業が楽しくなりそうです。
ありがとうございます。

お礼日時：2019/01/07 00:12

No.5 回答者： enunokokoro 回答日時： 2019/01/05 22:48

> 実行時エラー’5941’:

なんだろう？
GetFolder("フォルダのフルパス" & "フォルダ名").
の部分は問題ないのでしょうか？
例えば、エクスプローラーからフォルダのパスを取得するために
パスのコピーを使う場合なら、以下のようになりますよね。
"C:\Users\ユーザー名\Pictures\images"

("フォルダのフルパス" & "フォルダ名")において、フルパスの後
又はフォルダ名の前に\記号を付けていないとか？

この回答へのお礼

フォルダ名の記載は以下のようにしています。
For Each objFile In objFldr.GetFolder("C:\Users\FFF\Desktop" & "\123").Files

デスクトップにある123というフォルダです。

実は、そのフォルダ内にワードファイルとテキストファイルを同居させてました。
もしやと思い、画像ファイルのみにしたら、エラーが出現しなくなりました。

いろいろ試してみましたら、画像ファイルのみでなければというより、ファイルの数に対してのエラーのようです。
画像ファイルとテキストファイル混在でも合計がセクションの数と合っているとエラーは出ません。
マクロの結果としては、ページの中心に×印のオブジェクトが配置されるページが出現しますが、画像ではないので理解できます。

対応策がわかったので、最強です。
ありがとうございました。

お礼日時：2019/01/06 01:14

No.4 回答者： enunokokoro 回答日時： 2019/01/05 18:48

一応簡易版として、仮のマクロを提示しますね。

ネット上のマクロを継ぎ接ぎしただけなので、希望とは少し違うと
思いますが、指定したフォルダにある画像の数に応じた処理をする
ようにはなっています。
セクション数と画像数が同じなら、問題なく動くと思う。
差し込み印刷での新規文書を作らなくても、[セクション区切り]が
人数分用意されていれば動作します。

Sub 各ヘッダーに画像を挿入簡易版()
　Dim i As Integer
　Dim PIC As Shape
　Dim objFile As Object
　Dim objFldr As Object
　Dim sec As Section
　Dim hd_ft As HeaderFooter

' 各セクションのヘッダーで前と同じを解除
　For Each sec In ActiveDocument.Sections
　　For Each hd_ft In sec.Headers
　　　hd_ft.LinkToPrevious = False
　　Next
　Next sec

' 画面の更新を止める
　Application.ScreenUpdating = False

　Set objFldr = CreateObject("Scripting.FileSystemObject")
i = 0
' 画像フォルダを指定
　For Each objFile In objFldr.GetFolder("フォルダのフルパス" & "フォルダ名").Files
' 画像の数だけ処理する
　i = i + 1
' 各セクションに設定
　Set PIC = ActiveDocument _
　　　.Sections(i).Headers(wdHeaderFooterPrimary) _
　　　.Shapes.AddPicture(objFile)
' 配置関係の書式を設定
　　With PIC
　　　.LockAspectRatio = msoTrue
　　　.ScaleHeight 1, msoTrue
　　　.RelativeHorizontalPosition = _
　　　　wdRelativeHorizontalPositionPage
　　　.RelativeVerticalPosition = _
　　　　wdRelativeVerticalPositionPage
　　　.Left = wdShapeCenter
　　　.Top = wdShapeCenter
　　End With
　Next

' 画面の更新に戻す
　Application.ScreenUpdating = True

　Set objFldr = Nothing
　Set PIC = Nothing

End Sub

この回答へのお礼

非常にやりたいことに近く感激しています。
画像の数だけセクションを用意しておけばうまく行くようですね。

ただ、少し不思議な挙動をしますが、私のやり方が間違っているのでしょうか。
マクロの実行をするとエラーメッセージがでて中断します。
リッセットボタンを押した後に画像が各ページに配置されます。

エラーメッセージ
実行時エラー’5941’:
指定されたコレクションのメンバーは存在しません。

デバッグをクリックすると、下記部分が黄色くなります。
Set PIC = ActiveDocument _
.Sections(i).Headers(wdHeaderFooterPrimary) _
.Shapes.AddPicture(objFile)

リセットを押すと画像が配置されます。

ここまででも十分負荷が軽減されました。
ありがとうございます。

お礼日時：2019/01/05 22:03

No.3 回答者： enunokokoro 回答日時： 2019/01/05 00:39

とりあえず、関連する情報だけ提示しておきます。

https://www.relief.jp/docs/word-vba-header-foote …
https://www.relief.jp/docs/word-vba-add-shape-he …
https://www.wordvbalab.com/code/2386/

これらの組み合わせで、差し込み印刷から新規文書への差し込みを
した文書に対して、対応できるか検証してみます。
結果がいつになるかは不明です。

この回答へのお礼

VBAに関しての書籍を読んでも当てはまりそうなものが見つけられず、ネットからのサンプルの改良も試みましたが、エラーメッセージすら解釈できずお手上げです。
時間を割いていただいて本当にありがとうございます。

お礼日時：2019/01/05 02:55

No.2 回答者： enunokokoro 回答日時： 2019/01/04 12:55

現在の作業手順は、子供の出場した試合と結果、子供が書いた原稿

を配置し、ヘッダーを開いて[前と同じ]を解除し、画像を挿入して
から中央配置しているということですよね。
これらをページごとに繰り返しているので、できるだけ作業の手間
を省きたいということですね。

ページごとの基本となるレイアウトが同じであれば、差し込み印刷
を使う方法を私はお勧めします。

理由は幾つかあります。
・Excel側でデータを蓄積できることと
・人数の増減に対応しやすいこと
・Word側のページごとの基本のレイアウトが同じであること
・[新規文書への差し込み]で、ページでセクション区切りすること
・セクションが最初からあることで[前と同じ]を解除しやすいこと
・マクロでの処理が比較的簡単になるので、編集しやすいこと

事前にExcel側のデータを設定しないとならないが、次回以降の
管理がしやすくなります。
事前に、差し込み印刷のための差し込みフィールドを配置しておく
必要があるが、一度作成しておけば来年以降も再利用できます。

このことから、私としては差し込み印刷をお勧めします。

差し込み印刷での新規文書におけるマクロ処理については、簡単な
ものなら私なりに提示できるかもしれません。
（すぐには提示できませんが、検証後に回答するつもりです）

この回答へのお礼

早速ありがとうございます。
求めている最終結果はお察しの通りです。
感謝いたします。

お礼日時：2019/01/04 13:46

No.1 回答者： enunokokoro 回答日時： 2019/01/03 19:42

質問にあるVBAは、挿入してある画像の折り返し指定のまま単純に

等倍でページ中央に配置するだけのものですよね。

これだけでもかなりの行になるのですから、各ファイル名の取得や
セクションの追加、画像の配置などの処理が必要なので、マクロが
複雑で長くなります。
それを書いてくれる奇特な回答者がいるのか半信半疑です。

単純にページごとに画像を配置するだけなら、差し込み印刷で対応
したほうが簡単です。

何故、ヘッダーでないと駄目なのでしょうか？
各ページごとに画像を配置するだけのことではないのですか？