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!