Reputation: 50
I need to copy/paste Excel tables into PowerPoint with VBA.
I found this video: https://www.youtube.com/watch?v=dIqoXYy_Clg
The only difference is I want all my tables on the same slide.
When I run the sub, the first two tables are correctly positioned and sized but after the third, they all go into the middle of the slide and the width that I applied changes.
Is there a way to force the tables, after being pasted, to be moved and sized as originally specified.
Sub ExporttoPPT()
Dim ppt_app As New PowerPoint.Application
Dim pre As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim vSheet$
Dim vRange$
Dim vWidth As Double
Dim vHeight As Double
Dim vTop As Double
Dim vLeft As Double
Dim vShape As Double
Dim expRng As Range
Dim Export_PPT_Sh As Worksheet
Dim ConfigRng As Range
Dim xlfile$
Dim pptfile$
Set Export_PPT_Sh = ThisWorkbook.Sheets("Export_PPT")
xlfile = Export_PPT_Sh.[excelPth]
pptfile = Export_PPT_Sh.[pptPth]
Set wb = Workbooks.Open(xlfile)
Set pre = ppt_app.Presentations.Open(pptfile)
Set ConfigRng = Export_PPT_Sh.Range("Rng_Sheets")
For Each rng In ConfigRng
With Export_PPT_Sh
vSheet$ = .Cells(rng.Row, 4).Value
vRange$ = .Cells(rng.Row, 5).Value
vWidth = .Cells(rng.Row, 6).Value
vHeight = .Cells(rng.Row, 7).Value
vTop = .Cells(rng.Row, 8).Value
vLeft = .Cells(rng.Row, 9).Value
vShape = .Cells(rng.Row, 10).Value
End With
wb.Activate
Sheets(vSheet$).Activate
Set expRng = Sheets(vSheet$).Range(vRange$)
expRng.Copy
Set sld = pre.Slides(1)
sld.Shapes.PasteSpecial ppPasteBitmap
Set shp = sld.Shapes(vShape)
With shp
.Width = vWidth
.Height = vHeight
.Top = vTop
.Left = vLeft
End With
Set sld = Nothing
Set shp = Nothing
Set expRng = Nothing
Next rng
Set pre = Nothing
Set ppt_app = Nothing
wb.Close False
Set wb = Nothing
End Sub
I have a range on my Excel sheet with all the properties such as width, height etc...
I'm on Excel and PowerPoint 2013.
Upvotes: 1
Views: 912
Reputation: 50
Thanks to John Korchock I tried to use Placeholders instead of defining the width, heigth etc...
That way, the tables always go as the intended place and size. The code finally looks like this :
Sub ExporttoPPT()
Dim ppt_app As New PowerPoint.Application
Dim pre As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim vSheet$
Dim vRange$
Dim vPlcHolder As Long
Dim expRng As Range
Dim Export_PPT_Sh As Worksheet
Dim ConfigRng As Range
Dim xlfile$
Dim pptfile$
Set Export_PPT_Sh = ThisWorkbook.Sheets("Export_PPT")
'Path of the PowerPoint template and the excel worbook.
xlfile = Export_PPT_Sh.[excelPth]
pptfile = Export_PPT_Sh.[pptPth]
'Opening the excel and ppt workbooks
Set wb = Workbooks.Open(xlfile)
Set pre = ppt_app.Presentations.Open(pptfile)
Set ConfigRng = Export_PPT_Sh.Range("Rng_Sheets")
'Variables
For Each rng In ConfigRng
'Set Variables for tables
With Export_PPT_Sh
vSheet$ = .Cells(rng.Row, 4).Value
vRange$ = .Cells(rng.Row, 5).Value
vPlcHolder = .Cells(rng.Row, 6).Value
End With
'Export tables to PPT
wb.Activate
Sheets(vSheet$).Activate
Set expRng = Sheets(vSheet$).Range(vRange$)
expRng.Copy
Set sld = pre.Slides(1)
With shp
sld.Shapes.Placeholders(vPlcHolder).Select msoTrue
sld.Shapes.PasteSpecial ppPasteBitmap
End With
Set sld = Nothing
Set shp = Nothing
Set expRng = Nothing
Next rng
Set pre = Nothing
Set ppt_app = Nothing
wb.Close False
Set wb = Nothing
End Sub
It's may be not the most optimized code, but at least it works everytime without going as the wrong place.
Thank you again for the comments !
Upvotes: 0