希望简化我的 VBA答案

【问题标题】：Looking to simplify my VBA希望简化我的 VBA
【发布时间】：2015-11-20 16:17:42
【问题描述】：

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

【问题讨论】：

研究变量？编辑：见this。
也许这对CodeReview 而不是 SO 更好。另外，学习how to avoid .Select 也会有很大帮助。使用宏记录器在 Excel 中做一些简单、中等和“困难”的事情，并查看代码以了解它是如何工作的。看起来您只需要花一些时间来学习 VB，但它极大地通过学习如何删除 .Select 来帮助您开始理解，因为您将学习如何工作直接使用数据，而不是选择
查看循环。 for i = 6 to 295 step 10 将每十个循环一次，我将在其中表示行号。还要查看调整大小，这将允许您使用第一个单元格 Range("B" & i).resize(10,13) 将您的区域设置为复制为图像。
非常感谢，伙计们！我将询问代码审查，现在将开始审查您的建议。真的很感激！
Scott 这正是我想要的！

标签： vba excel

【解决方案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

【讨论】：