copy paste XL to PPT with 2 ranges

Question

Hello I am using VBA to loop for ranges and copy as picture and paste to PPT slide. I want to know is there possibility to include 1 more range to code. So VBA will copy paste 2 ranges as picture.

range is in following code. Works perfectly fine.
range is single cell ( B1 ) Can anyone give me solution how can I add multiple range ( as picture ) to the slide?

  Dim PP As PowerPoint.Application
  Dim PPpres As PowerPoint.Presentation
  Dim PPslide As Object
  Dim PpShape As PowerPoint.Shape
  Dim SlideTitle As String
  Dim SlideNum As Integer
  Dim WSrow As Long
  Dim Sh As Shape
  Dim Rng As Range
  Dim myShape As Object

'Open PowerPoint and create new presentation
Set PP = GetObject(class, "PowerPoint.Application")
PP.Visible = True
Set PPpres = PP.Presentations.Open(Filename:="C:\Users\Mac\Desktop	est\PPT.pptx")
'Specify the chart to copy and copy it

For i = 6 To Cells(70, Columns.Count).End(xlToLeft).Column Step 10

       With Cells(70, i)
    .Resize(1, 10).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
                    DoEvents
                    DoEvents
    .Offset(15, 0).PasteSpecial
    Range("B1").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
                    DoEvents
                    DoEvents
    .Offset(25, 0).PasteSpecial
End With


 'Give the last pasted picture a name.
                ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Name = "Chart" & k

 'Increase the count for naming pictures by 1
    k = k + 1


Set PPslide = PPpres.Slides.Add(1, 10)
PP.ActiveWindow.View.GotoSlide (1)
Set PPslide = PPpres.Slides(1)
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
 Set myShape = PPslide.Shapes(PPslide.Shapes.Count)
  'Set position:
      myShape.Left = 20
      myShape.Top = 180
      myShape.Height = 250
      myShape.Width = 950
'Make PowerPoint Visible and Active
PP.Visible = True
PP.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Next i

user_8874545 · Answer

The function .CopyPicture does not work on multiple ranges that aren't connected to each other - trying it would return the error message:

Run-time error 1004: this action won't work on multiple selections

So you'll need to execute a separate .CopyPicture for your separate Range (B1), maybe something like (details depending on what exactly you're trying to do):

With Cells(70, i)
    .Resize(1, 10).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    .Offset(150, 0).PasteSpecial
    Range("B1").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    .Offset(140, 0).PasteSpecial
End With

If you want the multiple ranges to return just one single image, you'll probably have to merge the resulting images in a separate step.

copy paste XL to PPT with 2 ranges

1 Answers