つらつら Excel VBA

私の備忘録です。

【Word VBA】挿入画像を各ページに分けて印刷したい

プリンタでスキャンしたデータを手間をかけずに一気に印刷したかったのです。Wordは画像挿入時に勝手に大きさは縮小してくれる!手間が減る!

'空文書に写真等をドラッグ&ドロップで文書に追加してから実行。
Sub 図をページ毎に分けて位置も揃える()
    
    'カーソルを文書頭に移動
    ThisDocument.Range(0, 0).Select
    
    '図をページ改行で区切る。
    Dim i As Integer
    For i = 2 To ThisDocument.InlineShapes.Count
        Selection.Move wdCharacter, 1 '1文字分カーソル移動
        Selection.InsertBreak Type:=wdPageBreak '改ページ
    Next
    
    '挿入した図は行内図とされる。前面に変更。
    Dim iShp As Word.InlineShape
    For Each iShp In ThisDocument.InlineShapes
        iShp.ConvertToShape.WrapFormat.Type = wdWrapFront
    Next
    
    '図の位置を整列させる。
    Dim shp As Word.Shape
    For Each shp In ThisDocument.Shapes
        Call centerShape(shp) '文書の中心に設定。
    Next
    
End Sub

'図の位置をページの中心に設定。
Sub centerShape(shp As Word.Shape)
    
    '横位置の調整
    Dim pw, lm, rm, hp, sw
    
    With ThisDocument.PageSetup
        pw = .PageWidth   'ページ横長さ
        lm = .LeftMargin  '左側余白
        rm = .RightMargin '右側余白
    End With
    
    hp = (pw - lm - rm) / 2 '中央の算出
    sw = shp.Width / 2 '図形横長さの半分
    shp.Left = hp - sw
    
    
    '縦位置の調整
    Dim ph, tm, bm, vp, sh
    
    With ThisDocument.PageSetup
        ph = .PageHeight   'ページ縦長さ
        tm = .TopMargin    '上側余白
        bm = .BottomMargin '下側余白
    End With
    
    vp = (ph - tm - bm) / 2 '中央の算出
    sh = shp.Height / 2 '図形縦長さの半分
    shp.Top = vp - sh
    
End Sub

・図の位置が中央から数ポイントずれる模様。数ポイントでガタガタ言わない!これでヨシ。
・中央にするだけなら他のスマートなやりかたがあるはず。知らんけど。
・Wordの図はInlineShapeとShapeが別モン。一括で処理したいのであれば統一するか、オブジェクトに対して処理することになるのかなー。
・色々試して分かったけど、Wordさんはたまに総ページ数を勘違いする模様。



各所に設置する確認用。

Debug.Print "図の数:" & ThisDocument.Shapes.Count
Debug.Print "インライン図の数:" & ThisDocument.InlineShapes.Count
Debug.Print "総ページ数:" & ThisDocument.Range.Information(wdNumberOfPagesInDocument)

以上。