Exporting Different Ranges from Excel to Different PPT Slides

[Jiveman7]

Hi,
i've been using this code to export a certain range from Excel to PPT (major thx to Haluk for helping me out with it):

Sub SendRangeDelete()

    Dim MyMyRng As Range
    Dim appPowerPoint As Object
    Dim filePowerPoint As Object
    Dim mySlide As Object
    Dim strPPTfile As String

    Set MyRng = ActiveSheet.Range("E5:I9")
    
    strPPTfile = "C:\Had\Duties.pptx"
    Set appPowerPoint = CreateObject(class:="PowerPoint.Application")
    Set filePowerPoint = appPowerPoint.Presentations.Open(strPPTfile)
    Set mySlide = filePowerPoint.Slides.Add(2, 11)
    filePowerPoint.Slides(3).Delete

    MyRng.Copy

    mySlide.Shapes.PasteSpecial DataType:=10
    appPowerPoint.Presentations(strPPTfile).Save
    appPowerPoint.Presentations(strPPTfile).Close
    appPowerPoint.Quit
    
    Application.CutCopyMode = False
    
End Sub

the presentation changes daily, so right now its exporting the range to slide 2, and deletes the old one which became now slide 3. how can i write the code so i can copy several ranges to different slides? for example range A1:B7 will be copied to slide 3, and range F5:H12 copied to slide 4?

thx

 

[Haluk]

Hi again;

The following code will paste Range("A1:B7") to slide No:3 and Range("F5:H12") to slide No:4

Change the file path (in red color) to suit your needs.

Sub SendRangeDelete_HD()
    Dim MyMyRng As Range
    Dim appPowerPoint As Object
    Dim filePowerPoint As Object
    Dim mySlide As Object
    Dim strPPTfile As String

    Set MyRng1 = ActiveSheet.Range("A1:B7")
    Set MyRng2 = ActiveSheet.Range("F5:H12")
    
    strPPTfile = "[COLOR=#ff0000][B]C:\TestFolder\TestPPT.pptx[/B][/COLOR]"
    Set appPowerPoint = CreateObject(class:="PowerPoint.Application")
    Set filePowerPoint = appPowerPoint.Presentations.Open(strPPTfile)
    
    Set mySlide = filePowerPoint.Slides.Add(3, 11)
    MyRng1.Copy
    mySlide.Shapes.PasteSpecial DataType:=10
    filePowerPoint.Slides(4).Delete

    Set mySlide = filePowerPoint.Slides.Add(4, 11)
    MyRng2.Copy
    mySlide.Shapes.PasteSpecial DataType:=10
    filePowerPoint.Slides(5).Delete
    
    appPowerPoint.Presentations(strPPTfile).Save
    appPowerPoint.Presentations(strPPTfile).Close
    appPowerPoint.Quit
    
    Application.CutCopyMode = False
End Sub

 

[Haluk]

The below code may be more convenient for you to use, if you want to paste more ranges to different slides.

The only thing you have to do is; add the relevant lines to the procedure, named "Main".

The code will paste the related ranges to dedicated slides, and delete the old ones.

Don't forget to revise the file path of the PPT file (in red color) to suit your needs.

Sub [B]Main[/B]()
    Call SendRange_2_PPT(Range("A1:B7"), 3)
    Call SendRange_2_PPT(Range("F5:H12"), 4)
End Sub
'
Sub SendRange_2_PPT(RangeXL As Range, SlideNum As Byte)
    Dim appPowerPoint As Object
    Dim filePowerPoint As Object
    Dim mySlide As Object
    Dim strPPTfile As String

    Set MyRng = RangeXL
    
    strPPTfile = "[COLOR=#ff0000][B]C:\TestFolder\TestPPT.pptx[/B][/COLOR]"
    Set appPowerPoint = CreateObject(class:="PowerPoint.Application")
    Set filePowerPoint = appPowerPoint.Presentations.Open(strPPTfile)
    
    Set mySlide = filePowerPoint.Slides.Add(SlideNum, 11)
    MyRng.Copy
    mySlide.Shapes.PasteSpecial DataType:=10
    filePowerPoint.Slides(SlideNum + 1).Delete
    
    appPowerPoint.Presentations(strPPTfile).Save
    appPowerPoint.Presentations(strPPTfile).Close
    appPowerPoint.Quit
    
    Application.CutCopyMode = False
End Sub

 

[Jiveman7]

You are a king among men, my friend thx!

 

[Haluk]

You are welcome ...