0
votes

Happy Sunday everyone. I need some advice on what would be the best approach to continue a code - my worry is to keep it smooth and simple somehow (the file is a 20MB file). I have the below coding (thanks @BigBen). It copy paste a game of products (x8) from one worksheet into a ppt after refresh. I could reproduce the same logic to Sheet "B" from range "C1:AE37"

Do you recommend to use a new module for each sheet? - or can I upgrade the coding below with like a text box asking what to export (Select Sheet A, Sheet B, etc..) and loop the if back to each copy-paste sheets range to a ppt slide? which ones are more efficient to keep the Excel smooth? many thanks in advance for the help.

Option Explicit
Sub ExportToPPT()

Dim ppApp As PowerPoint.Application
Set ppApp = New PowerPoint.Application

Dim ppFileName As String
ppFileName = "C:\Users\\Desktop\Financial Summary.pptx"

Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Open(filename:=ppFileName)

Dim ppSlide As PowerPoint.Slide

Dim i As Integer
For i = 2 To 9
    Set ppSlide = ppPres.Slides(i)

    Dim j As Integer
    For j = ppSlide.Shapes.Count To 1 Step -1
        If ppSlide.Shapes(j).Type = msoPicture Then
            ppSlide.Shapes(j).Delete
        End If
    Next j
Next i

Dim Sel As Range
Dim source As Range
Dim l As Long

For l = 8 To 1 Step -1
Workbooks("WWDWT.xlsm").Sheets("Graph Data").Range("E4").Value = l
Application.Calculate

Set source = ActiveWorkbook.Sheets("A").Range("D1")
ActiveWorkbook.Sheets("A").Range("D1:AF40").Copy

Set ppSlide = ppPres.Slides(l + 1)
ppSlide.Shapes.PasteSpecial ppPasteBitmap
Next l
End Sub
1

1 Answers

0
votes

I'd just parametrise all of the things, like so:

Option Explicit
Sub ExportToPPT(ppFileName As String, xlFileName as String, xlCalculationSheetName as String, xlDataSheetName)

Dim ppApp As PowerPoint.Application
Set ppApp = New PowerPoint.Application

Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Open(filename:=ppFileName)

Dim ppSlide As PowerPoint.Slide

Dim i As Integer
For i = 2 To 9
    Set ppSlide = ppPres.Slides(i)

    Dim j As Integer
    For j = ppSlide.Shapes.Count To 1 Step -1
        If ppSlide.Shapes(j).Type = msoPicture Then
            ppSlide.Shapes(j).Delete
        End If
    Next j
Next i

Dim Sel As Range
Dim source As Range
Dim l As Long

For l = 8 To 1 Step -1
Workbooks(xlFileName).Sheets(xlCalculationSheetName).Range("E4").Value = l
Application.Calculate

Set source = ActiveWorkbook.Sheets(xlCalculationSheetName).Range("D1")
ActiveWorkbook.Sheets(xlCalculationSheetName).Range("D1:AF40").Copy

Set ppSlide = ppPres.Slides(l + 1)
ppSlide.Shapes.PasteSpecial ppPasteBitmap
Next l
End Sub

Parametrise more of the things as necessary.