VBA code to replace contents in a Powerpoint table using Excel data

[MitchelK]

I would like to copy Excel data into an existing Powerpoint table using VBA in order to keep the Powerpoint table formatting, e.g. I need a VBA code to open an existing PPT presentation, select a predefined slide let's say Slide(1), select the Table1 shape in Powerpoint and copy the Excel table data as text into the Powerpoint table, overwriting the existing data. The Excel table is set-up exactly the same as the one in Powerpoint. Using linked/embedded table objects in Powerpoint is not an option.

Below my current VBA Code which pastes the Excel table into a new PPT slide as an HTML object.

Any suggestions?

Many thanks in advance!


Option Explicit

Dim PP As Object
Dim PP_File As Object
Dim PP_Slide As Object
Dim x As Single
Dim ActFileName As Variant


Sub ExporttoPPT()

ActFileName = Sheet1.Range("Source").Value
Set PP = CreateObject("Powerpoint.Application")
PP.Activate
Set PP_File = PP.Presentations.Open(ActFileName)
PP.Visible = True

Copytonewsheet "Rangename", "Title"

Set PP_Slide = Nothing
Set PP_File = Nothing
Set PP = Nothing
Worksheets(1).Activate


Exit Sub


End Sub

Private Sub Copytonewsheet(myRangeName As String, MyTitle As String)

Application.GoTo Reference:=myRangeName
Selection.Copy

PP.ActiveWindow.ViewType = 1
PP.ActiveWindow.View.GotoSlide Index:=PP.ActivePresentation.Slides.Add(Index:=PP.ActivePresentation.Slides.Count + 1, Layout:=16).SlideIndex
PP.ActiveWindow.View.PasteSpecial 8
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue

End Sub

 

[Rijnsent]

Hi Mitchel,
this post seems to solve the same issue: http://www.mrexcel.com/forum/excel-...s-code-data-powerpoint-table-not-objects.html
Cheers,
Koen

 

[MitchelK]

Hi Koen,

Thanks for your reply. As I need to copy & paste about 40 tables from Excel to Powerpoint, I used the code below to solve the issue eventually.

Best, Mitchel


Sub ExporttoPPT()

Application.ScreenUpdating = False
Application.EnableEvents = False
Dim NextShape As Integer
Dim ActFileName As Variant
On Error Resume Next

ActFileName = Sheet1.Range("Source").Value
Set PP = CreateObject("Powerpoint.Application")
PP.Activate
Set PP_File = PP.Presentations.Open(ActFileName)
PP.Visible = True

Range("ExcelTable1").Copy
PP_File.Slides(1).Shapes("Table1").Table.cell(1, 1).Select
PP.ActiveWindow.View.Paste

PP.ActiveWindow.View.GotoSlide (1)

Set PP_Slide = Nothing
Set PP_File = Nothing
Set PP = Nothing
Worksheets(1).Activate

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub