Excel VBA 如何循环一个冗余条件

Question

大家好，我试图通过复制粘贴循环来简化我的代码。下面的代码在 1) 刷新一个产品的一个单元格和 2) 将刷新的 table 复制到特定的幻灯片编号上成功。

我需要将过程复制 x7 次 - 而不是有一个长代码，我想我可以使用以下循环条件。 - 刷新产品（从 8 到 1），计算 - 然后将 excel table 复制粘贴到其幻灯片组合是这样的。产品（表格）转到演示文稿（幻灯片）产品 8 转到幻灯片 9 产品 7 转到幻灯片 8 等。

Option Explicit
Sub ExportToPPT()

    Dim ppApp As PowerPoint.Application
    Set ppApp = New PowerPoint.Application
    Dim Sel As Range
    Dim source As Range`

    Workbooks("WWDWT.xlsm").Activate
    Sheets("Graph Data").Select
    Range("E4").Value = "8"
    Application.Calculate

    Set Sel = Selection
    Set source = ActiveWorkbook.Sheets("waterfall").Range("D1")
    ActiveWorkbook.Sheets("waterfall").Range("D1:AE40").Copy

    Set ppSlide = ppPres.Slides(9)
    ppSlide.Shapes.PasteSpecial ppPasteBitmap

End Sub

我如何循环 Range("E4").Value = "8" 以更改为 7,6,5,4... 并将它们中的每一个分配给紧随其后的 Set ppSlide = ppPres.Slides(9) Slide(8),7, 6,5 等.. 提前感谢大家的帮助

Answer 1

使用简单的 For 循环，如下所示：

Sub ExportToPPT()
    ...
    Dim i as Long

    For i = 8 to 1 Step - 1
        Workbooks("WWDWT.xlsm").Activate
        Sheets("Graph Data").Select
        Range("E4").Value = i
        Application.Calculate

        Set Sel = Selection
        Set source = ActiveWorkbook.Sheets("waterfall").Range("D1")
        ActiveWorkbook.Sheets("waterfall").Range("D1:AE40").Copy

        Set ppSlide = ppPres.Slides(i + 1)
        ppSlide.Shapes.PasteSpecial ppPasteBitmap
    Next i

End Sub

但请注意，通常不需要使用 Activate 和 Select。您可以简化

Workbooks("WWDWT.xlsm").Activate
Sheets("Graph Data").Select
Range("E4").Value = i

至

Workbooks("WWDWT.xlsm").Sheets("Graph Data").Range("E4").Value = i

而且你从不使用 Set Sel = Selection 中的 Sel 所以也许你可以摆脱它（还有 source 吗？）

我猜 ActiveWorkbook 实际上也是 Workbooks("WDWT.xlsm")...

Excel VBA 如何循环一个冗余条件

Excel VBA how to loop a redundant conditions

excel

powerpoint

vba