Excel VBA Paste Range powerpoint actual filename

benposaner

New Member
Joined
Jan 7, 2021
Messages
7
Office Version
  1. 365
  2. 2019
Platform
  1. 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.
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
 

Some videos you may like

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Watch MrExcel Video

Forum statistics

Threads
1,126,952
Messages
5,621,797
Members
415,856
Latest member
jimb2k

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top