Copiar Imagens/Gráficos excel e colar no Power Point

[Mariana.akai]

Ola pessoal,

Eu montei a macro anexa para que ela copie e cole as tabelas, gráficos e imagens do excel para o Power Point, porém quando ela copia e cola, elas não ficam na posição e tamanho que eu gostaria ( em cada slide isso vai variar, então eu tinha criado uma tabela no excel com os tamnhos e posições, porém a macro não esta puxando de la), será que há algo errado no meu código, por favor?

 

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 wb As Workbook
Dim rng As Range

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

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

Application.DisplayAlerts = False

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

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

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

'Após abrir ppt buscar intervalos

For Each rng In configrng

'--------Getvariables
    
    With Exportsh
        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)
 
 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
 

Obrigada!