I want to paste multiple tables and charts to ppt.I have also created a table with below columns. 1.Sheet name 2.Slide no 3.Range of chart/table 4.Height 5.Width 6.Top position 7.Left position It works perfect but i want the code to perform the below tasks as well.
- Delete existing tables or charts in all slides
- Paste only charts/graphs as Enhanced metafile and tables as editable tables keeping source formatting.
Please help on the same.
Option explicit
Sub pastetoppt()
Dim ppt app As New PowerPoint Application
Dim pre As PowerPoint.Presentation
Dim pppre As PowerPoint.Presentation
Dim slde As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim wb As Workbook
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 vSlide_No As Long
Dim expRng As Range
Dim mainSh As Worksheet
Dim cofigng As Range
Dim xlfile$
Dim pptfile$
Application.DisplayAlerts = False
Set mainSh = ThisWorkbook. Sheets ("Testing")
Set cofigRng = mainSh. Range ("Rng
sheets")
xlfile = mainSh. [excelPth]
pptfile = mainSh. [pptPth]
Set wb = Workbooks.Open (xlfile)
Set pre = ppt_app.Presentations.Open (pptfile)
For Each rng In cofigng
‘set VARIABLES
With mainSh
vSheet$ = .Cells (rng. Row, 2) .Value
vRange$ = .Cells (rng.Row, 3) . Value
vWidth = .Cells (rng.Row, 4) .Value
vHeight =.Cells (rng. Row, 5) .Value
vTop =.Cells (rng. Row, 6) .Value
vLeft =.Cells (rng. Row, 7).Value
vSlide_No = .Cells (rng. Row,8) .Value
End With
‘__export to ppt
wb.Activate
Sheets (vSheet$) .Activate
Set expRng = Sheets (vSheet$) . Range (vRange$)
expRng. Copy
Set slde = pre. Slides (vSlide_No)
slde. Shapes. PasteSpecial ppPasteEnhancedMetafile
Set shp = slde. Shapes (3)
With shp
. Top = vTop
.Left = vLeft
Width = vWidth
Height = vHeight
End With
Set shp = Nothing
Set slde = Nothing
Set expRng = Nothing
Application.CutCopyMode = False
Set expRng = Nothing
Next rng
‘Pre.save
‘Pre.close
Set pre = Nothing
Set ppt app = Nothing
wb.Close False
Set wb = Nothing
Application.DisplayAlerts = True
End Sub