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.
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:
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:
<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]
The entire code below:
Code:
<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>