Hi all, I need some assistance with VBA copy paste from Excel to PowerPoint. I am completely new to this, hope you can help me with this.
Scenario is - I have 6 different excel range (these are excel range and not tables) on one worksheet of excel (as shown in below picture). I want to copy these and paste it into existing Power point which is saved in my system. The way I want to paste it is 2 tables on one slide - which means there will be total of three slides in my PPT.
I tried codes here and there which allows me to achieve some part of it but not all of it. The hardest part is to position all those ranges in a specific way in PowerPoint. I want it in this way -
This is the code I tried-
Thanks a ton in advance for the help!
Scenario is - I have 6 different excel range (these are excel range and not tables) on one worksheet of excel (as shown in below picture). I want to copy these and paste it into existing Power point which is saved in my system. The way I want to paste it is 2 tables on one slide - which means there will be total of three slides in my PPT.
I tried codes here and there which allows me to achieve some part of it but not all of it. The hardest part is to position all those ranges in a specific way in PowerPoint. I want it in this way -
This is the code I tried-
VBA Code:
Sub excelrangetopowerpoint_month()
Dim powerpointapp As Object
Set powerpointapp = CreateObject("powerpoint.application")
Dim destinationPPT As String
destinationPPT = ("FILE LOCATION")
On Error GoTo ERR_PPOPEN
Dim mypresentation As Object
Set mypresentation = powerpointapp.Presentations.Open(destinationPPT)
On Error GoTo 0
Application.ScreenUpdating = False
PasteToSlide mypresentation.Slides(1), Worksheets("Output (2)").Range("B6:T31")
PasteToSlide mypresentation.Slides(2), Worksheets("Output (2)").Range("B32:T51")
PasteToSlide mypresentation.Slides(3), Worksheets("Output (2)").Range("B54:T66")
'duplicate this line for all slides/ranges
'PasteToSlide mypresentation.Slides(2), Worksheets("objectives").Range("m2")
powerpointapp.Visible = True
powerpointapp.Activate
Application.CutCopyMode = False
ERR_PPOPEN:
Application.ScreenUpdating = True 'don't forget to turn it on!
If Err.Number <> 0 Then
MsgBox "Failed to open " & destinationPPT, vbCritical
End If
End Sub
Private Sub PasteToSlide(mySlide As Object, rng As Range)
rng.Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = enhanced metafile
Dim myShape As Object
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 152
myShape.Top = 152
End Sub
Thanks a ton in advance for the help!