为多张工作表添加循环代码

Question

我一直在使用此代码将单个范围转换为 Power Point as Picture，代码运行良好。我想在适用于多张纸的代码中添加一个循环。

我在 Col"A" 中有 Sheet 个名称，在 Col"B" 中有 Sheet 个范围，在 Col"C" 中有状态。

如果 Col"C" 个单元格是 = "Include"，则这些工作表范围将作为图片粘贴到 PowerPoint 中，所有其他将被忽略。

非常感谢您的帮助。

Const ppFileName = "C:\Topline\Topline Writeup.pptx"

Dim PPT As Object
Set PPT = CreateObject("Powerpoint.Application")
PPT.Visible = True
' Use this if file already exists:
' PPT.Presentations.Open Filename:=ppFileName
' Use this if you want to create a new file:
PPT.Presentations.Add
PPT.ActivePresentation.slides.Add Index:=1, Layout:=12 

Worksheets("Pivot").Range("FC3:FP35").CopyPicture Appearance:=xlScreen, Format:=xlPicture
With PPT.ActivePresentation.Slides(1)
    .Shapes.PasteSpecial
    With .Shapes(.Shapes.Count)
        .Left = 200
        .Top = 100
        .Width = 500
    End With
End With
' Use this if you want to save an already existing file:
' PPT.ActivePresentation.Save
' Use this if you want to create a new file:
PPT.ActivePresentation.SaveAs ppFileName  
PPT.Quit
Set PPT = Nothing

Answer 1

请尝试下一个方法：

Sub SelectSheets_Ranges()
  Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  ReDim arr(lastR - 1)
  For i = 2 To lastR
        If sh.Range("C" & i).value = "Include" Then
            arr(k) = sh.Range("A" & i).value & "|" & sh.Range("B" & i).value: k = k + 1
        End If
  Next i
  ReDim Preserve arr(k - 1)
  For i = 0 To UBound(arr)
        arrSplit = Split(arr(i), "|")
        Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1))
        Debug.Print rng.Address(external:=True): stop 'see its address in Immediate Window
        'do whatever you need with each rng...
  Next
End Sub

为多张工作表添加循环代码

Adding a Loop to Code Work for Multiple Sheets

excel

powerpoint

vba