Търся опростяване на VBA - excel, vba, excel-vba

Една от задачите ми е създаването на голям изход, при който вземам екран, генериран от програма, форматирам изхода и след това изрязвам / поставям като екран за печат в 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")

... и така на всеки десет реда. Тогава го направих, така че да изреже и залепи всяка страница на печатната област по страница и да я пусна на крайния лист. По този начин мога лесно да прехвърля всеки в .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 знае да зададе хоризонтален прекъсване на страницата на всеки десет реда, след което да отпечата изрязване / поставяне, без да изписва физически всеки ред и да посочва точните клетки?

Отговори:

Хммм нещо като:

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