Search code examples
excelvbapowerpoint

Adding a Loop to Code Work for Multiple Sheets

I have been using this code which convert the single range to Power Point as Picture and the code is working fine. I want to add a loop on the code where it will work for multiple sheets.

I have Sheet Name in Col"A", Sheet Ranges in Col"B" and the Status is in Col"C".

Where If Col"C" cells are = "Include" then those sheets ranges will be paste as picture to Power Point and all other will be ignored.

Your help will be greatly appreciated.

enter image description here

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
Solution

  • Please, try the next approach:

    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