私のVBAを簡素化するために - excel、vba、excel-vba

私の割り当ての1つは、大きな出力を作成することです。これにより、プログラムによって生成された画面を取得し、出力をフォーマットし、印刷画面としてPowerPointにカット/ペーストします。私は次のように書いた：

Range("B6:M6").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.PageSetup.PrintArea = "$B$6:$M$300"
Set ActiveSheet.HPageBreaks(1).Location = Range("B16")
Set ActiveSheet.HPageBreaks(2).Location = Range("B26")
Set ActiveSheet.HPageBreaks(3).Location = Range("B36")
Set ActiveSheet.HPageBreaks(4).Location = Range("B46")
Set ActiveSheet.HPageBreaks(5).Location = Range("B56")
Set ActiveSheet.HPageBreaks(6).Location = Range("B66")

...など、10行ごとに。 次に、各印刷領域をページごとにカットアンドペーストし、エンドシートにドロップするようにしました。そうすれば、それぞれを.pptに簡単に転送できます。最終的には、プロセス全体を自動化するのに十分な学習をしたいのですが、それを段階的に実行する必要があります。切り取り/貼り付け/印刷は次のようになります。

Range("B6:M15").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.ShapeRange.Width = 719.28

Sheets("Private Company (w Debt)").Select
Range("B16:M25").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Selection.ShapeRange.Width = 719.28

Sheets("Private Company (w Debt)").Select
Range("B26:M35").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.ShapeRange.Width = 719.28

私のマクロでは、コードは改ページ（40ページ程度）に直接続いており、適切に実行されます。

どうやって見せてくれる人がいますかこれをより直感的に書いて、VBAが10行ごとに水平改ページを設定し、各行を物理的に書き出さずに正確なセルを指定せずにカット/ペーストを印刷するようにしますか？

回答：

うーん

Dim i as Long
Dim copyRange as Range
Range("B6:M6").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.PageSetup.PrintArea = "$B$6:$M$300"


For i = 1 to 6   "## Modify from 6 to a larger number, as needed
"Set up your page break locations
Set ActiveSheet.HPageBreaks(i).Location = Range("B" & 6 + (10 * i))
"copy/paste in to Sheet2:
" use the resize method to get a 10 rows x 12 columns range
Set copyRange = ActiveSheet.HPageBreaks(i).Location.Resize(10, 12)
"copyPicture:
copyRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture

With Workshheets("Sheet2")
.Paste
.Shapes.Range(Array("Picture " & i)).ShapeRange.Width = 719.28
End With

Next