I use the following code in an attempt to transfer the sheet named Sector Attrib which contains a table anda chart and various other objects. I am trying to transfer the whole sheet but find that only the first object on the sheet which happens to be a table is transferred to the powerpoint slide.
I am at a loss to know why it transfers just the first object and not the whole sheet. Thanks.
Private Sub cmdUseOLEWithFileName_Click()
Dim newSlide As PowerPoint.slide
Dim sh As PowerPoint.shape
Dim excelWB As Workbook
Dim shtName As String
Dim objOLE As Object
Dim xlFilePath As String
Set newSlide = GetNewSlide() ' New blank slide for "MyPresentation.pptx" open or not.
Set excelWB = ActiveWorkbook
shtName = "Sector Attrib"
xlFilePath = excelWB.Path & "\" & excelWB.Name
Worksheets(shtName).Activate
newSlide.Shapes.AddOLEObject Left:=50, top:=50, Width:=600, Height:=250, Filename:=xlFilePath, Link:=False
Set excelWB = Nothing
Set newSlide = Nothing
End Sub
' The below code which is called from above simply opens powerpoint if not open etc and makes a new slide:
Function GetNewSlide(Optional layOutType = PowerPoint.PpSlideLayout.ppLayoutBlank) As PowerPoint.slide
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.slide
Dim FileAndPath As String
FileAndPath = "C:\Users\User\Desktop\L&P\MyPresentation.pptx" ' Get this from the s/sheet??
On Error Resume Next
' Check if PowerPoint is already open
Set pptApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
' If PowerPoint is not open, create a new instance
If pptApp Is Nothing Then
Set pptApp = New PowerPoint.Application
End If
' Set error handling to resume next in case of any errors during presentation open
On Error Resume Next
' Check if the presentation is already open
Set pptPres = Nothing
On Error Resume Next
Set pptPres = pptApp.Presentations("MyPresentation.pptx")
On Error GoTo 0
' If the presentation is not open, open it
If pptPres Is Nothing Then
Set pptPres = pptApp.Presentations.Open(FileAndPath)
End If
' Show the PowerPoint application
pptApp.Visible = True
' Add a new slide to the presentation
' This adds to position 1.
Set pptSlide = pptPres.Slides.Add(1, layOutType)
Set GetNewSlide = pptSlide
' Clean up objects
' Set pptSlide = Nothing
' Set pptPres = Nothing
' Set pptApp = Nothing
End Function
I am at a loss to know why it transfers just the first object and not the whole sheet. Thanks.
Private Sub cmdUseOLEWithFileName_Click()
Dim newSlide As PowerPoint.slide
Dim sh As PowerPoint.shape
Dim excelWB As Workbook
Dim shtName As String
Dim objOLE As Object
Dim xlFilePath As String
Set newSlide = GetNewSlide() ' New blank slide for "MyPresentation.pptx" open or not.
Set excelWB = ActiveWorkbook
shtName = "Sector Attrib"
xlFilePath = excelWB.Path & "\" & excelWB.Name
Worksheets(shtName).Activate
newSlide.Shapes.AddOLEObject Left:=50, top:=50, Width:=600, Height:=250, Filename:=xlFilePath, Link:=False
Set excelWB = Nothing
Set newSlide = Nothing
End Sub
' The below code which is called from above simply opens powerpoint if not open etc and makes a new slide:
Function GetNewSlide(Optional layOutType = PowerPoint.PpSlideLayout.ppLayoutBlank) As PowerPoint.slide
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.slide
Dim FileAndPath As String
FileAndPath = "C:\Users\User\Desktop\L&P\MyPresentation.pptx" ' Get this from the s/sheet??
On Error Resume Next
' Check if PowerPoint is already open
Set pptApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
' If PowerPoint is not open, create a new instance
If pptApp Is Nothing Then
Set pptApp = New PowerPoint.Application
End If
' Set error handling to resume next in case of any errors during presentation open
On Error Resume Next
' Check if the presentation is already open
Set pptPres = Nothing
On Error Resume Next
Set pptPres = pptApp.Presentations("MyPresentation.pptx")
On Error GoTo 0
' If the presentation is not open, open it
If pptPres Is Nothing Then
Set pptPres = pptApp.Presentations.Open(FileAndPath)
End If
' Show the PowerPoint application
pptApp.Visible = True
' Add a new slide to the presentation
' This adds to position 1.
Set pptSlide = pptPres.Slides.Add(1, layOutType)
Set GetNewSlide = pptSlide
' Clean up objects
' Set pptSlide = Nothing
' Set pptPres = Nothing
' Set pptApp = Nothing
End Function