EXCELでの画像位置調整マクロ(VBA)

質問

Excelの１シート内に大量の画像を貼り付けてあるブックがあります。
このシートをそのまま印刷した場合、１つの画像が2ページにまたがってしまう部分が
いくつもあります。

これらを自動的に調整しなおして１つのブックにする方法はないでしょうか？
最終的に１つのファイルとして問題なく印刷できれば、どのような方法でもかまいません。
ただし、手動での位置調整は画像自体が大量にあるため、非常に時間がかかります。
マクロ的に処理できる方法をご存知の方、教えてください。

回答No.1

keithin · ベストアンサー

Sub macro1()
　Dim w As Worksheet
　Dim w0 As Worksheet
　Dim s As Shape
　Dim n As Long
　Dim h As Range

　Set w0 = ActiveSheet
　w0.ResetAllPageBreaks
　Application.ScreenUpdating = False
　Set w = Worksheets.Add(Before:=Worksheets(1))

’画像を上から順に並べる
　For Each s In w0.Shapes
　　n = n + 1
　　w.Cells(n, 1) = s.TopLeftCell.Row
　　w.Cells(n, 2) = s.Name
　Next
　w.Range("A:B").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlNo
　listhpbs w0

’改ページにかかっているか調査する
　For Each h In w.Range("B2:B" & w.Range("B65536").End(xlUp).Row)
　　Set s = w0.Shapes(h)
　　If Application.Lookup(s.TopLeftCell.Row, w.Range("D:D")) <> Application.Lookup(s.BottomRightCell.Row, w.Range("D:D")) Then
　　　w0.HPageBreaks.Add Before:=w0.Cells(s.TopLeftCell.Row, "A")
　　　listhpbs w0
　　End If
　Next

　Application.DisplayAlerts = False
　Worksheets(1).Delete
　Application.DisplayAlerts = True
　Application.ScreenUpdating = True
End Sub

Sub listhpbs(w As Worksheet)
　Dim h As HPageBreak
　Dim n As Long
’改ページ位置を調べる
　Cells(1, "D") = 1
　For n = 1 To w.HPageBreaks.Count
　　Worksheets(1).Cells(n + 1, "D") = w.HPageBreaks(n).Location.Row
　Next n
End Sub

画像を配置したシートを開き，macro1を実行します。

★ご質問に明記されていませんが，水平改ページにかかっているかを調べます
★ご質問に明記されていませんが，簡単のため画像は縦に一列並んでいるとします
★言わずもがなですが「そのままの大きさで１ページを超える大きさの画像」は無いものとします