Thread: Macro Copy/Paste Cells into Powerpoint in HTML

Hi every one,

First, I'm French so please be kind with my english... It makes now 3 days I am trying to copy/paste cells from Excel to PowerPoint. It works very well when I paste as a picture format (EnhancedMetafile) but I can't manage to paste the cells in HTML format (table I can modify into PPT : what I need !!!)...

I found I had to first create the tab in ppt and paste each cells in it.

I tried so the following code but "error 424"

Would you please try to indicate me where is the rub ?
FYI : the macro has to set up a NEW pptPresentation

There is maybe another solution (I also tried a Pastespecial HTML but it doesn't work)

Thank you very much for your kind interset and the time you will allow...

Sub copietab()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim pptTempTable As PowerPoint.Table
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
Dim rngCopy As Range
Dim lngRow As Long
Dim lngCol As Long

Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add

With PptDoc

.Slides.Add Index:=1, Layout:=ppLayoutBlank

Set rngCopy = ThisWorkbook.Worksheets("graphiques").Range("B6:K40")

With Diapo
With PptDoc.Slides(1).Shapes.AddTable(rngCopy.Rows.Count, rngCopy.Columns.Count, 2, 120, 715, -1)

For lngRow = 1 To rngCopy.Rows.Count
For lngCol = 1 To rngCopy.Columns.Count

rngCopy.Cells(lngRow, lngCol).Copy.Table.Cell(lngRow, lngCol).Shape.TextFrame.TextRange.Characters.Paste
' Object needed

Next
Next

End With
End With
End With
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Restitution.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
 
MsgBox "Exportation de la restitution réussie"
End Sub

or

Sub snb()
  Sheets(1).Range("B6:K40").Copy

  With New PowerPoint.Application
    .Visible = msoTrue
    .Presentations.Add
    .Presentations(1).Slides.Add 1, ppLayoutBlank
    .Presentations(1).Slides(1).Shapes.Paste
  End With
End Sub

without a reference to the powerpoint library:

Sub snb()
  Sheets(1).Range("B6:K40").Copy

  With createobject("PowerPoint.Application")
    .Visible = msoTrue
    .Presentations.Add
    .Presentations(1).Slides.Add 1, 12
    .Presentations(1).Slides(1).Shapes.Paste
  End With
End Sub