Export Excel Range To PPT As An Excel Table Not As Picture Using VBA Macro

Dear All,

Need a help from you all.

I've a sheet with lot of data on it and want to export six different ranges of excel to a PPT as a table ( each range in a slide) and not as a picture. I'm new to VBA and shall be grateful if some one could help me.



Worksheet name - Status


Ranges to be exported are

B16:C19
B23:H33
B35:H36
B67:V80
B374:V390
B1303:V1320

Many thanks

So do you want these to be exported to a new slide? Or will you be selecting a slide of your choosing, and then have the ranges exported to existing slides, or new slides within that existing PPT file? If the latter, will the new slides start from the last existing slide?

Thank you for your reply.

The most preferred option is to start it in a new slide and if not the programme to indicate the user to open a ppt and keep it ready, before it executes the export.

Many thanks again

Here's this should help

Code:

---

Sub ExcelFox()

    Dim appPPT As Object 'PowerPoint.Application
    Dim pptNew As Object 'PowerPoint.Presentation
    Dim lyt As Object 'PowerPoint.CustomLayout
    Dim vararrRangeToExport As Variant, varEach As Variant
   
    vararrRangeToExport = Array("B16:C19", _
                                "B23:H33", _
                                "B35:H36", _
                                "B67:V80", _
                                "B374:V390", _
                                "B1303:V1320")
    Set appPPT = CreateObject("PowerPoint.Application")
    appPPT.Visible = 1 'msoCTrue
    Set pptNew = appPPT.Presentations.Add(-1) 'msoTrue
    For Each varEach In vararrRangeToExport
        pptNew.Slides.Add Index:=pptNew.Slides.Count + 1, Layout:=12 'ppLayoutBlank
        Range(varEach).Copy
        Call pptNew.Slides(pptNew.Slides.Count).Shapes.PasteSpecial(10) 'ppPasteOLEObject
    Next varEach
   
End Sub

---

Thank you very much for your kind help.

Unfortunately I get a run time error '-2147417851 (8001010105)' ;

Method 'PasteSpecial' of object 'Shapes's failed and the debug mode stops at the line

' Call pptNew.Slides(pptNew.Slides.Count).Shapes.PasteSpe cial(10) 'ppPasteOLEObject'

the ppt also restarts even if I keep it open ( I've office 2007 version).

Many thanks again

Add the Microsoft PowerPoint 12.0 Library in the VBA project, and use this code

Code:

---


Sub ExcelFox()

    Dim appPPT As PowerPoint.Application
    Dim pptNew As PowerPoint.Presentation
    Dim vararrRangeToExport As Variant, varEach As Variant
   
    vararrRangeToExport = Array("B16:C19", _
                                "B23:H33", _
                                "B35:H36", _
                                "B67:V80", _
                                "B374:V390", _
                                "B1303:V1320")
    On Error Resume Next
    Set appPPT = GetObject(, "PowerPoint.Application")
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    If appPPT Is Nothing Then
        Set appPPT = CreateObject("PowerPoint.Application")
        appPPT.Visible = 1 'msoCTrue
    End If
    Set pptNew = appPPT.Presentations.Add(-1) 'msoTrue
    For Each varEach In vararrRangeToExport
        pptNew.Slides.Add Index:=pptNew.Slides.Count + 1, Layout:=12 'ppLayoutBlank
        Range(varEach).Copy
        Call pptNew.Slides(pptNew.Slides.Count).Shapes.PasteSpecial(10) 'ppPasteOLEObject
    Next varEach
   
End Sub

---

Hi Excel Fox- thank you for your kind time and help in this regard.


I've already added the Microsoft PowerPoint 12.0 Library in the VBA project under Tools > References , and used this code and I'm afraid that I'm still getting the same error.

Sorry.