Wadax
Wadax

Reputation: 50

Position and size with copy/paste from Excel to PowerPoint with VBA

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

Answers (1)

Wadax
Wadax

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

Related Questions