Position and sizing issue with copy/paste from Excel to PowerPoint with VBA

Question

I need to copy/paste tables that I have in excel into powerpoint with a VBA command.

I found this video : https://www.youtube.com/watch?v=dIqoXYy_Clg

And it exactly responds to what I want to do, the only difference that I have is that I want all my tables on the same slide.

However when I'm running 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 change too. I've found that they are some problems with positioning when you copy/paste from excel to powerpoint, but I would like to know if there's a way to force the tables after being pasted to be moved and sized as I originally specified them.

Here's the actual code :

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 on my excel sheet a range with all the properties such as width, height etc... I'm also on excel and powerpoint 2013 if it's relevant.

It's my first post, so I hope that I've been clear enough. Thanks by advance for the future responses.

question from:https://stackoverflow.com/questions/65934413/position-and-sizing-issue-with-copy-paste-from-excel-to-powerpoint-with-vba

Answer 1

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 goign as the wrong place.

Thank you again for the comments !