I am editing a macro too export the selected table into a ppt slide. However, I am struggling with the code (it makes my laptop app crashes) and I was wondering if anyone had a better way of proceeding.
My goal is to automize a formated table in powerpoint populated with an Excel table data. The table in the ppt would be sized accordingly to the Excel table which can be either selected or named “table_to_export”
Any clues ?
Sub ExportToPowerPoint()
Dim pptApp As Object
Dim pptPres As Object
Dim pptSlide As Object
Dim pptShape As Object
Dim SelectedRange As Range
' Set the range of the Excel table based on current selection
Set SelectedRange = Selection
' Check if there is a valid selection
If SelectedRange Is Nothing Then
MsgBox "Please select a range in Excel before running the macro."
Exit Sub
End If
' Create a new PowerPoint application or get the existing one
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
If pptApp Is Nothing Then
Set pptApp = CreateObject("PowerPoint.Application")
End If
On Error GoTo 0
' Make PowerPoint visible
pptApp.Visible = True
' Open an existing presentation or create a new one
On Error Resume Next
Set pptPres = pptApp.ActivePresentation
If pptPres Is Nothing Then
Set pptPres = pptApp.Presentations.Add
End If
On Error GoTo 0
' Add a new slide
' Use 1 for ppLayoutTitle, which is the layout type for a title slide
Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, 1)
' Copy the Excel range
SelectedRange.Copy
' Paste the range into PowerPoint
pptSlide.Shapes.Paste
' Get the pasted shape
Set pptShape = pptSlide.Shapes(pptSlide.Shapes.Count)
' Adjust the size and position of the pasted object
pptShape.LockAspectRatio = msoFalse ' Allow independent resizing of width and height
pptShape.Left = 50 ' Adjust the left position as needed
pptShape.Top = 100 ' Adjust the top position as needed
pptShape.Width = pptPres.PageSetup.SlideWidth - 100 ' Adjust the width as needed
pptShape.Height = pptPres.PageSetup.SlideHeight - 150 ' Adjust the height as needed
' Optionally, you can add a title to the slide
pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Your Slide Title"
' Clean up
Set pptShape = Nothing
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
End Sub
Kede51 is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.