Question

我的一项任务是创建一个大输出，我可以通过程序生成屏幕，格式化输出，然后将其作为打印屏幕剪切/粘贴到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知道每十行设置一个水平分页符，然后打印剪切/粘贴而不用实际写出每一行并指定确切的单元格？

Answer 1

嗯，比如：

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

希望简化我的VBA

1 个答案: