Click here for important information about

paste excel charts and worksheets to ppt

May 10, 2011 at 11:04:34
Specs: Windows XP

I need help on how to paste excel charts and worksheets to powerpoint using a vba code. I have researched a lot of websites but in vain. I am aware of the product but would liek to see if a vba macro code can do this programmatically.

We need to open and exisitng excel file that contains charts in chart sheets and data tables in worksheets. We need to open an existing Powerpoint file.

Example excel file macro template is HFIDetails.xlsm. The file has two chart sheets HFIChart1 and HFIChart2. The file has a worksheet called HFI.

A Powerpoint file called NewPackage exists with 6 slides.

We need to replace the charts in slide 2, 3 with HFiChart1 and HFIChart2 in the excel file with the same size, height , width. We need to replace the data table in slide 4 in the Powerpoint file with the worksheet HFI in the excel file .

I tried the below code but the code pastes in the active slide and we have to navigate to the active sheet in excel and the active slide in Powerpoint.

Also, the chart and data table in Powerpoint is not replaced. The chart and data table still exist and the pasted chart and worksheet from excel is pasted on top with a different size.

This does not serve our purpose.

Also, I came upon the below code in an old post dated way back in 2008 in this forum. I have pasted that code at the end.

Thanks for your help.

Sub RangeToPresentation()
' Set a VBE reference to Microsoft Excel Object Library

Dim XLApp As Excel.Application
Dim PPSlide As Slide

' Reference existing instance of Excel
Set XLApp = GetObject(, "Excel.Application")

' Make sure a range is selected
If Not TypeName(XLApp.Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.", _
vbExclamation, "No Range Selected"
' Can only paste into slide view
Application.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = ActivePresentation.Slides _

' Copy the range as a piicture
XLApp.Selection.CopyPicture Appearance:=xlScreen, _

' Paste the range

' Align the pasted range
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

' Clean up
Set PPSlide = Nothing
End If

Set XLApp = Nothing
End Sub

Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With


' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

/* This code is from an old post in 2008 posted in this forum*/

Sub CreateNewPowerPointPresentation()
' to test this code, paste it into an Excel module
' add a reference to the PowerPoint-library this is done from the Tools ---> References menu path and you
'need to find the microsoft powerpoint check box and check it. Then excel can use ppt objects within itself
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i As Integer, strString As String
Dim Graphcount As Integer

Count = 0 'initialise count variable
i = 1
'returns the number of charts on the sheet at the time the macro is run.
'User customises the worksheets name to sheet that holds all the charts
Graphcount = Worksheets("HFI").ChartObjects.Count

Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new presentation
' or open an existing presentation
'Set pptPres = pptApp.Presentations.Open("F:\Focus\AnitaPradeep\Copy Paste Project\TestExcelToPPT\New Orig Package Mar 2011_Sample to Start.pptx")

Do While i < Graphcount ' starts a loop to copy charts

ActiveSheet.ChartObjects(i).Activate ' selects the chart object by its index number

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" 'edit to put a generic title on each slide or
' take this line out if you dont want a generic slide title to appear on each slide
.Shapes.PasteSpecial ppPasteDefault
With .Shapes(.Shapes.Count) ' sizes the graph on the slide
.Left = 120
.Top = 125.125
.Width = 480
.Height = 289.625
End With
End With

Application.CutCopyMode = False ' end cut/copy from Excel
Set pptSlide = Nothing
i = i + 1 ' increment the graph count to copy the next chart on the excel sheet

On Error Resume Next ' ignore errors

On Error GoTo 0 ' resume normal error handling
Set pptPres = Nothing

pptApp.Visible = True ' display the application
'pptApp.Quit ' or close the PowerPoint application
Set pptApp = Nothing

End Sub

See More: paste excel charts and worksheets to ppt

May 10, 2011 at 11:34:49
If I need to format the chart size , I try using the below but get an error. Want to resize the chart height and width.


With pptSlide
'.Shapes(1).TextFrame.TextRange.Text = "Slide Title" 'edit to put a generic title on each slide or
' take this line out if you dont want a generic slide title to appear on each slide
.Shapes.PasteSpecial ppPasteDefault
With .Shapes(.Shapes.Count)
.Left = 120
.Top = 125.125
.Width = 480
.Height = 289.625
End With

Report •
Related Solutions

Ask Question