Hi,
I've sourced some bits of code from various, helpful forums that will copy a range from excel to a new Powerpoint file. The first section of code below works perfectly (Sub ExcelToNewPowerPoint(), but requires a specified range, e.g. A1:J28, whereas the table I am using is dynamic and will change according to filters used in the workbook. The solution I am aiming for is to allow the user to set the filters in the workbook and then hit a button to copy the data into a new PowerPoint slide.
Can someone help me change the code so that the range is dynamic, so that it copies only cells with data in them. I have found some code below (Sub DynamicRange() that uses the LastRow and Last Column functions - but despite my best efforts I cant seem to combine the two.
Thanks!
Sub ExcelToNewPowerPoint()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
' Create instance of PowerPoint
Set PPApp = CreateObject("Powerpoint.Application")
' For automation to work, PowerPoint must be visible
' (alternatively, other extraordinary measures must be taken)
PPApp.Visible = True
' Create a presentation
Set PPPres = PPApp.Presentations.Add
' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide
' Add first slide to presentation
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
'Step 4: Copy the range as a picture
Sheets("Data").Range("DynamicRange").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
'Step 5: Paste the picture and adjust its position
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'Step 6: Add the title to the slide
SlideTitle = "My First PowerPoint Slide"
PPSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
'Step 7: Memory Cleanup
PP.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
Sub DynamicRange()
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Data")
Set StartCell = Range("A1")
'Refresh UsedRange
Worksheets("Data").UsedRange
'Find Last Row and Column
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
Bookmarks