Issue with copy/paste tables/shapes from Excel to PowerPoinnt

[mariana_akai]

Dear all, I hope you're well and safe.

I built the following scheme

-I have one excel file (1-Base Indicadores) contaning tables and shapes that I need to paste in one (2) Power Point Presentation. To do that, I created an excel file (3) who reads the (1) Base Indicadores and copy some ranges to the (2) Powerpoint.

I'm facing some issues here:
- I want to define the size and position of the content after paste on (2) Powerpoint and I put the information in my file (3) who reads the excel source (1), but after the code runs and I open the powerpoint (2) file, this rule is not applied.
- The code also is not recognizing the shapes on (1) Excel to paste on (2)*.ppt.

Coudl you please support to verify what's happening? Here is my code:

[I]Option Explicit

    'app
    'presentation
    'slide
    'shapes
    'text frame
    'text
    
Sub Exportarppt()

Dim ppt_app As New PowerPoint.Application
Dim presentation As PowerPoint.presentation
Dim slide As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim chart As ChartObject 'para definir o grafico
Dim wb As Workbook
Dim rng As Range

'nome das variaveis das colunas
Dim vAba$
Dim vIntervalo$
Dim vLargura As Long
Dim vAltura As Long
Dim vTopo As Double
Dim vEsquerda As Double
Dim vslide_n As Long
Dim expRng As Range

'Configurar fonte planilha excel

Dim Exportar As Worksheet
Dim configrng As Range
Dim xfile$
Dim pptfile$

Application.DisplayAlerts = False

Set Exportar = ThisWorkbook.Sheets("Exportar")
Set configrng = Exportar.Range("rng_aba")

xfile = Exportar.[excelpath]
pptfile = Exportar.[PptPath]


'Abrir apresentação ppt
Set wb = Workbooks.Open(xfile)
Set presentation = ppt_app.Presentations.Open(pptfile)

'Após abrir ppt buscar intervalos

For Each rng In configrng

'--------Getvariables
    
    With Exportar
        vAba$ = .Cells(rng.Row, 2).Value
        vIntervalo$ = .Cells(rng.Row, 3).Value
        vLargura = .Cells(rng.Row, 4).Value
        vAltura = .Cells(rng.Row, 5).Value
        vTopo = .Cells(rng.Row, 6).Value
        vEsquerda = .Cells(rng.Row, 7).Value
        vslide_n = .Cells(rng.Row, 8).Value
            
    End With
    
    
'-----------EXPORT TO PPT
 
 wb.Activate
 Sheets(vAba$).Activate
 Set expRng = Sheets(vAba$).Range(vIntervalo$)
 expRng.Copy
 
 Set slide = presentation.Slides(vslide_n)
 slide.Shapes.PasteSpecial ppPasteBitmap
 'Set shp = slide.Shapes(4)
 'Teste conforme planilhando
 Set shp = slide.Shapes(slide.Shapes.Count)
 
 
 With shp
 .Top = vTopo
 .Left = vEsquerda
 .Width = vLargura
 .Height = vAltura
 End With
 
 Set shp = Nothing
 Set slide = Nothing
 Set expRng = Nothing
 
 
 Application.CutCopyMode = False
 Set expRng = Nothing
 
Next rng

presentation.Save
'pre.Close

Set presentation = Nothing
Set ppt_app = Nothing

wb.Close False
Set wb = Nothing

Application.DisplayAlerts = True

End Sub

[/I]


Thanks!
Mariana

 

[Mehe]

Dear all, I hope you're well and safe.

I built the following scheme

-I have one excel file (1-Base Indicadores) contaning tables and shapes that I need to paste in one (2) Power Point Presentation. To do that, I created an excel file (3) who reads the (1) Base Indicadores and copy some ranges to the (2) Powerpoint.

I'm facing some issues here:
- I want to define the size and position of the content after paste on (2) Powerpoint and I put the information in my file (3) who reads the excel source (1), but after the code runs and I open the powerpoint (2) file, this rule is not applied.
- The code also is not recognizing the shapes on (1) Excel to paste on (2)*.ppt.

Coudl you please support to verify what's happening? Here is my code:

[I]Option Explicit

    'app
    'presentation
    'slide
    'shapes
    'text frame
    'text
   
Sub Exportarppt()

Dim ppt_app As New PowerPoint.Application
Dim presentation As PowerPoint.presentation
Dim slide As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim chart As ChartObject 'para definir o grafico
Dim wb As Workbook
Dim rng As Range

'nome das variaveis das colunas
Dim vAba$
Dim vIntervalo$
Dim vLargura As Long
Dim vAltura As Long
Dim vTopo As Double
Dim vEsquerda As Double
Dim vslide_n As Long
Dim expRng As Range

'Configurar fonte planilha excel

Dim Exportar As Worksheet
Dim configrng As Range
Dim xfile$
Dim pptfile$

Application.DisplayAlerts = False

Set Exportar = ThisWorkbook.Sheets("Exportar")
Set configrng = Exportar.Range("rng_aba")

xfile = Exportar.[excelpath]
pptfile = Exportar.[PptPath]


'Abrir apresentação ppt
Set wb = Workbooks.Open(xfile)
Set presentation = ppt_app.Presentations.Open(pptfile)

'Após abrir ppt buscar intervalos

For Each rng In configrng

'--------Getvariables
   
    With Exportar
        vAba$ = .Cells(rng.Row, 2).Value
        vIntervalo$ = .Cells(rng.Row, 3).Value
        vLargura = .Cells(rng.Row, 4).Value
        vAltura = .Cells(rng.Row, 5).Value
        vTopo = .Cells(rng.Row, 6).Value
        vEsquerda = .Cells(rng.Row, 7).Value
        vslide_n = .Cells(rng.Row, 8).Value
           
    End With
   
   
'-----------EXPORT TO PPT
 
 wb.Activate
 Sheets(vAba$).Activate
 Set expRng = Sheets(vAba$).Range(vIntervalo$)
 expRng.Copy
 
 Set slide = presentation.Slides(vslide_n)
 slide.Shapes.PasteSpecial ppPasteBitmap
 'Set shp = slide.Shapes(4)
 'Teste conforme planilhando
 Set shp = slide.Shapes(slide.Shapes.Count)
 
 
 With shp
 .Top = vTopo
 .Left = vEsquerda
 .Width = vLargura
 .Height = vAltura
 End With
 
 Set shp = Nothing
 Set slide = Nothing
 Set expRng = Nothing
 
 
 Application.CutCopyMode = False
 Set expRng = Nothing
 
Next rng

presentation.Save
'pre.Close

Set presentation = Nothing
Set ppt_app = Nothing

wb.Close False
Set wb = Nothing

Application.DisplayAlerts = True

End Sub

[/I]


Thanks!
Mariana

Is your issue resolved?