Excel/VBA: how to use already defined PowerPoint layout + how to crop the picture copied

[luckyluke]

Hi everybody,

yesterday, I've been dealing with one issue in the code below, which I succesfully solved, thanks to the fellow members.

Now, I'm going further with it and trying to figure out another puzzles:

1) Would anyone know how to use one of the prepared slide layouts within PowerPoint deck, after opening the presentation? I've been applying this codeb below, but it always adds another version of layout to the "master slide" selection of layouts.

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 11.9999990463257px;">  Set mySlide = myPresentation.Slides.Add(x, ppLayoutObject)

</code>[/COLOR]

2) Would anyone know how to crop copied picture within PowerPoint by using Excel VBA command? I don't know why, but whenever I copy the range from Excel to PowerPoint, there is always a red line at the bottom of the range coppied...

The entire code below:

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 11.9999990463257px;">Sub ExcelRangeToPowerPoint()

Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape

Dim objPPT As Object

Dim rngx As Variant
Dim rng(1 To 19) As Range

'-------------------------------------------------------------------------------------------------------------------------------------------------------
'                                  SELECT DATA TO BE COPIED INTO THE DECK
'-------------------------------------------------------------------------------------------------------------------------------------------------------

'Copy Range from Excel. In the commands below, please define the range of data you want to copy into the deck

  Set rng(1) = ThisWorkbook.Sheets("1").Range("B3:I34")
  Set rng(2) = ThisWorkbook.Sheets("2").Range("B3:J41")
  Set rng(3) = ThisWorkbook.Sheets("3").Range("B3:L42")
  Set rng(4) = ThisWorkbook.Sheets("4").Range("B3:P44")
  Set rng(5) = ThisWorkbook.Sheets("5").Range("B3:M45")
  Set rng(6) = ThisWorkbook.Sheets("6").Range("B5:L33")
  Set rng(7) = ThisWorkbook.Sheets("7").Range("B3:I27")
  Set rng(8) = ThisWorkbook.Sheets("8").Range("B3:I27")
  Set rng(9) = ThisWorkbook.Sheets("9").Range("B3:N44")
  Set rng(10) = ThisWorkbook.Sheets("10").Range("B3:O28")
  Set rng(11) = ThisWorkbook.Sheets("11 ").Range("B3:O28")
  Set rng(12) = ThisWorkbook.Sheets("12").Range("B3:O29")
  Set rng(13) = ThisWorkbook.Sheets("13").Range("B3:O31")
  Set rng(14) = ThisWorkbook.Sheets("14").Range("B3:O29")
  Set rng(15) = ThisWorkbook.Sheets("15").Range("B3:P38")
  Set rng(16) = ThisWorkbook.Sheets("16").Range("B3:K39")
  Set rng(17) = ThisWorkbook.Sheets("17").Range("B3:K40")
  Set rng(18) = ThisWorkbook.Sheets("18").Range("B3:K40")
  Set rng(19) = ThisWorkbook.Sheets("19").Range("B3:M22")
  

'-------------------------------------------------------------------------------------------------------------------------------------------------------
'                                  OPEN POWERPOINT DECK
'-------------------------------------------------------------------------------------------------------------------------------------------------------
Set PowerPointApp = CreateObject("PowerPoint.Application")
PowerPointApp.Visible = True

Path = ThisWorkbook.Path
Set myPresentation = PowerPointApp.Presentations.Open(Path & "\_____Name_of_the_file____")
PowerPointApp.Activate
  
'-------------------------------------------------------------------------------------------------------------------------------------------------------
'                                ADD NEW SLIDES INTO THE DECK
'-------------------------------------------------------------------------------------------------------------------------------------------------------

x = 2

For Each rngx In rng


x = x + 1

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(x, ppLayoutObject)
  
'Copy Excel Range
  rngx.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShapeRange.Left = 30
      myShapeRange.Top = 110
      myShapeRange.Width = 590
      myShapeRange.Height = 400
    

Next rngx

End Sub</code>