1

I copy one range and paste as picture to a PowerPoint slide.

I want to copy two ranges and paste as picture.

  1. range is in following code. Works.
  2. range is single cell ( B1 )

How can I add multiple ranges (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\test\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
Community
  • 1
  • 1
Elmir Akbarov
  • 21
  • 5

1 Answers1

0

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.

E. Villiger
  • 876
  • 10
  • 27
  • Thanks for reply,I tried this solution. It copy paste both range to worksheet,but not copy paste both of them to PPT. Instead it copy only second range alone. I don't want to merge pictures. Instead can be option do add both ranges with different positions to slide? I updated code, may be now will be more clear. – Elmir Akbarov Aug 06 '22 at 19:27
  • Your code is still incomplete and therefore not reproducible (PPpres is not defined). But basically what you could do is 1) copy the first range, 2) paste it in powerpoint, 3) copy the 2nd range (B1), 4) paste it in powerpoint - in that order. – E. Villiger Aug 07 '22 at 10:29
  • I updated code, now it is full. Thanks for solution. But in that case, it will 1) copy each range 2) Create new slide 3) Add each ranges to different slides.. – Elmir Akbarov Aug 07 '22 at 23:38