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

mariana_akai

New Member
Joined
Mar 31, 2021
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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
 

Attachments

  • Excel source (1).jpg
    Excel source (1).jpg
    71.3 KB · Views: 16
  • Excel source (1).jpg
    Excel source (1).jpg
    71.3 KB · Views: 16
  • Excel to export from excel to ppt (3).jpg
    Excel to export from excel to ppt (3).jpg
    69.7 KB · Views: 16

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
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:

VBA 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?
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top