benposaner
New Member
- Joined
- Jan 7, 2021
- Messages
- 9
- Office Version
- 365
- 2019
- Platform
- Windows
Hi
I've cobbled the below from a few examples and it works fine, but I need to change it so it will paste ranges into several different powerpoints, not just the one active one. The powerpoints have to be open already.
I've got code that calls the code and passes various parameters, such as slide number and images sizes, etc. What I also want to do it add the name of the powerpoint so it will paste into a different one, when required.
Currently is will only paste into the active presentation.
So how to I set myPresentation to the actual name of an already opened Powerpoint?
Suppose I'd want the correct code for something like:
Hope that makes sense.
Many Thanks.
I've cobbled the below from a few examples and it works fine, but I need to change it so it will paste ranges into several different powerpoints, not just the one active one. The powerpoints have to be open already.
I've got code that calls the code and passes various parameters, such as slide number and images sizes, etc. What I also want to do it add the name of the powerpoint so it will paste into a different one, when required.
Currently is will only paste into the active presentation.
VBA Code:
'Set my current Powerpoint window as activated
Set myPresentation = PowerPointApp.ActivePresentation
So how to I set myPresentation to the actual name of an already opened Powerpoint?
Suppose I'd want the correct code for something like:
VBA Code:
'Set my current Powerpoint window as actual name.
Set myPresentation = PowerPointApp.FileName("Powerpoint01.pptx)
Hope that makes sense.
Many Thanks.
VBA Code:
Sub ExcelToPowerpoint(iSlide, iLeft, iTop, iHeight, iWidth)
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim DestinationPPT As String
Dim myShape As Object
Dim mySlide As Object
Dim myChart As Excel.Chart
'Copy Range from Excel
Set rng = Worksheets("Sheet1").Range("E10:Z43")
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Set my current Powerpoint window as activated
Set myPresentation = PowerPointApp.ActivePresentation
'Set which slide to paste into
Set mySlide = myPresentation.Slides(iSlide)
'Copy Excel Range
rng.Copy
'Paste range to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.LockAspectRatio = msoFalse
myShape.Left = iLeft
myShape.Top = iTop
myShape.Height = iHeight
myShape.Width = iWidth
'Make PowerPoint Visible and Active
'PowerPointApp.Visible = True
'PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub