CODEWITHSUNDEEP
vbaexcelpowerpoint
Adit2789
Adit2789

Reputation: 149

How to paste excel data into powerpoint and still allow the user to edit data

I was wondering if there was a way of exporting/pasting an excel range into powerpoint, while still allowing the user to edit the result. The code I keep seeing on the internet pastes data from excel into powerpoint as a picture. Below is an example:

Sub export_to_ppt(ByVal sheetname As String, ByVal initialSelection As String) ', ByVal cols As Integer, ByVal rows As Integer)

Application.ScreenUpdating = False
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Copy Range from Excel
'Set rng = ThisWorkbook.ActiveSheet.Range("B17:D50")

'Create an Instance of PowerPoint
On Error Resume Next

'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
Err.Clear

'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
  MsgBox "PowerPoint could not be found, aborting."
  Exit Sub
End If

On Error GoTo 0

'Optimize Code
Application.ScreenUpdating = False

'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add

'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12)  '12 = ppLayoutBlank

'Copy Excel Range

Dim rowCount As Integer
Dim colcount As Integer
Dim i As Integer
Dim No_sheets As Integer
No_sheets = Worksheets("Control_Sheet").Range("AP2").Value + 2

For i = 3 To No_sheets
Worksheets("Control_Sheet").Activate
Worksheets("Control_Sheet").Cells(i, 42).Select
    If Worksheets("Control_Sheet").Cells(i, 42).Value = sheetname Then

        rowCount = Worksheets("Control_Sheet").Cells(i, 44).Value
        colcount = Worksheets("Control_Sheet").Cells(i, 43).Value
        GoTo resume_copy
    End If
Next i

resume_copy:
Worksheets(sheetname).Activate
Worksheets(sheetname).Range(initialSelection).Select
Selection.Resize(rowCount, colcount).Select
Selection.Copy


'Paste to PowerPoint and position
Application.Wait Now + TimeValue("00:00:01")
mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:
myShape.Left = 1
myShape.Top = 1
myShape.Width = 950
PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Upvotes: 1

Views: 640

Answers (2)

TheSilkCode
TheSilkCode

Reputation: 366

Replace: 

mySlide.Shapes.PasteSpecial DataType:=2

With:

mySlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, DisplayAsIcon:=msoFalse, link:=msoFalse

Hope this helps, TheSilkCode

Upvotes: 1

Robomato
Robomato

Reputation: 277

You can, but this process was very buggy for me when running a large ppt deck. This works by using the ppt shapes position as the location of the paste. Use a template ppt slide to test, you can paste tables and graphs this way. 

    Dim myApp As PowerPoint.Application
    Dim myPres As PowerPoint.Presentation
    Dim myStatsSlide As PowerPoint.Slide

    Set myApp = New PowerPoint.Application
    Set myPres = myApp.ActivePresentation

    Set myStatsSlide = myPres.Slides(1)

    Dim mySheet As Worksheet
    Set mySheet = ActiveSheet

   'Copy table as table, not image
    Dim mySumTable As Range
    Set mySumTable = mySheet.Range("A1:C5")

    mySumTable.Copy

    myStatsSlide.Shapes.Placeholders(1).Select

    myPres.Windows(1).View.Paste

   'Copy Chart, as chart not image
    Dim monoChart As ChartObject

    'MONO CHART
    monoChart.Select
    ActiveChart.ChartArea.Copy

    Debug.Print monoChart.Name


    myStatsSlide.Shapes.Placeholders(2).Select

    myPres.Windows(1).View.Paste

    Debug.Print monoChart.Name

Upvotes: 0

Related Questions