I have a chart in Excel where my macro populates 10 shapes by the right side of the chart area. I want to copy only the chart to the power point and could not find a way to disable copying the shapes so far. If I copy the chart, it copies the shapes as well.
Here's a quick example that copies the first chart from the active sheet, pastes it to the first slide of the active presentation, and deletes any existing shapes from the pasted chart...
'Declare Excel variables
Dim ChartObj As ChartObject
'Declare PowerPoint variables
Dim ppApp As Object
Dim ppPres As Object
Dim ppChartObj As Object
Dim ppShape As Object
'Copy first chart from active sheet
Set ChartObj = ActiveSheet.ChartObjects(1)
ChartObj.Copy
'Paste chart into first slide of active presentation
Set ppApp = GetObject(, "PowerPoint.Application")
Set ppPres = ppApp.ActivePresentation
Set ppChartObj = ppPres.slides(1).Shapes.Paste(1)
'Delete shapes from chart
For Each ppShape In ppChartObj.Chart.Shapes
ppShape.Delete
Next ppShape
Hope this helps!
Related
I have a PowerPoint presentation containing several charts. Each of these charts have an embedded PowerPoint Excel file behind the chart. The embedded Excel file source its data from an Excel (Master) file. When I make any changes in the Excel (Master) file these changes are not automatically displayed in the chart. In order to get the change reflected in the chart I need to right click the chart and then choose "Edit data". I found below code which helps me to automatically open all the embedded Excel files in the presentation.
My question is now, if I do not want the macro to open all the embedded Excel files but perhaps only a specific chart (chart 1). If so, how should I then re-write the code so it only open the embedded Excel file for Chart 1?
Update PowerPoint chart using VBA
Sub update2()
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart
Dim Wb As Object
Dim App As Object
Set myPresentation = ActivePresentation
{For Each sld In myPresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set myChart = shp.Chart
myChart.ChartData.Activate
myChart.Refresh
Set Wb = myChart.ChartData.Workbook
Set App = Wb.Application
Wb.Close (0)
End If
Next
Next
App.Quit
End Sub
I am new to using VBA so there is a chance this has been done before but I cant find a discussion on this. I have a template ppt already created that I need tables to be added to specific slides (see image).
Would it be easier to create a table and run it into Powerpoint? or Connect it with a pre-existing table in PPT that can be populated?
There are a couple of options you have. You can either export the Excel Range as an OLE Object, a PowerPoint Table Object, or a Linked OLE Object. Each has its own advantages and disadvantages but, in your case, I would just paste it as a table if the formatting doesn't have to match exactly.
Here is some code that will demonstrate pasting a range of cells to PowerPoint, from Excel, using VBA.
Sub ExportMultipleRangeToPowerPoint_Method2()
'Declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim SldArray as Variant
'Declare Excel Variables
Dim ExcRng As Range
Dim RngArray As Variant
'Populate our array. This will define two ranges that exist in Sheet 1.
'This also populates our slide array which specifies which slide each range is pasted on.
'YOU WILL NEED TO CHANGE THIS IN ORDER FOR IT TO WORK ON YOURS!
RngArray = Array(Sheet1.Range("A1:F8"), Sheet1.Range("A10:F18"))
SldArray = Array(1, 2)
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Loop through the range array, create a slide for each range, and copy that range on to the slide.
For x = LBound(RngArray) To UBound(RngArray)
'Set a reference to the range
Set ExcRng = RngArray(x)
'Copy Range
ExcRng.Copy
'Enable this line of code if you receive an error about the range not being in the clipboard - This will fix that error by pausing the program for ONE Second.
'Application.Wait Now + #12:00:01 AM#
'GRAB AN EXISTING SLIDE.
Set PPTSlide = PPTPres.Slide(SldArray(x))
'Paste the range in the slide as a Table (Default).
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
Next x
End Sub
Again, it really depends on how frequently you update it but most of the time I push people to keep it easier before making it harder. If you need more a step by step walkthrough, I do have a series on YouTube which you can follow along. It's especially helpful if you want to do more advanced stuff like positioning or even pasting as different data types. Here is the playlist: Excel to PowerPoint
I am writing a macro through Excel that will help me do the steps below. Currently, I am stuck at step 3.
'Copy specific cellblock in Excel sheet
'Open existing Powerpoint presentation (which exists of four slides with approximately 6-7 charts on each slides whose underlying data has to be replaced with the copied cellblock)
'Select specific chart on slide 1
'Open the specific chart's underlying data by right clicking on "Edit Data"
Select the cellblock in the sheet that pops up and replace it with the data that was copied from Excel in step 1
My issue at the moment lies in step 3, where I am not able to select any chart in my PowerPoint. I would also appreciate all guidance that could help me with step 4 and 5 as well.
My current code looks as the following:
Sub MyMacroRätt()
'Marks and copies a cell block in my Excel file
ActiveSheet.Range("R55", "T75").Select
Selection.Copy
'Open an existing PowerPoint file
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
PPT.Presentations.Open Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm"
Dim PPPres As PowerPoint.Presentation
Set PPPres = PPT.ActivePresentation
Dim pslide As PowerPoint.Slide
Dim pchart As PowerPoint.Chart
'Mark the first chart on the first slide
With ActiveWindow.Selection.ShapeRange(1)
If .HasChart = True Then
'Open Edit Data-sheet for selected chart
Chart.ActivateChartDataWindow
End If
End With
'Select existing data i Edit Data-sheet and replace with copied data from Excel
End Sub
Thanks Domenic, it actually worked!
Now I want to repeat this again for more charts in my PPT, so in the first step "Set rngCopyFrom = ActiveSheet.Range("R55", "T75") I will change the cell block that should be copied from Excel. However, when I will repeat the whole code you sent I also want to change the selected chart into THE SECOND CHART on the first slide in the PPT. Do you have ideas on how I can adjust this section so that it instead selects the second chart in slide 1, and pastes the new cell block into that charts worksheet?
If pptShape.HasChart Then 'first chart
In other words, I want a code that selects the second chart on slide 1, another code that selects the third chart on slide 1, another code that selects the fourth chart on slide 1..... and so on. In total I have 8 charts on each slide, and in total I have four slides with charts whose data that needs to be updated.
The following macro opens the specified PowerPoint file, activates the ChartData so that its workbook is opened, copies the specified data into the first worksheet of the workbook, starting at A2, and then closes it. You'll need to change the destination cell (A2) accordingly.
Option Explicit
Sub MyMacroRätt()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim rngCopyFrom As Range
Set rngCopyFrom = ActiveSheet.Range("R55", "T75")
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")
With pptPres.Slides(1) 'first slide
For Each pptShape In .Shapes
If pptShape.HasChart Then 'first chart
Exit For
End If
Next pptShape
If Not pptShape Is Nothing Then
pptShape.Chart.ChartData.Activate
With rngCopyFrom
pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
pptShape.Chart.ChartData.Workbook.Close
End If
End With
Set pptApp = Nothing
Set pptPres = Nothing
Set pptShape = Nothing
Set rngCopyFrom = Nothing
End Sub
Edit
To choose which chart to update, for example the second chart, try the following instead...
Option Explicit
Sub MyMacroRätt()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim rngCopyFrom As Range
Dim ChartNum As Long
Dim ChartIndex As Long
ChartNum = 2 'second chart
Set rngCopyFrom = ActiveSheet.Range("R55", "T75")
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")
With pptPres.Slides(1) 'first slide
ChartIndex = 0
For Each pptShape In .Shapes
If pptShape.HasChart Then
ChartIndex = ChartIndex + 1
If ChartIndex = ChartNum Then
Exit For
End If
End If
Next pptShape
If Not pptShape Is Nothing Then
pptShape.Chart.ChartData.Activate
With rngCopyFrom
pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
pptShape.Chart.ChartData.Workbook.Close
End If
End With
Set pptApp = Nothing
Set pptPres = Nothing
Set pptShape = Nothing
Set rngCopyFrom = Nothing
End Sub
I have already the code to open a specific powerpoint template from a sharepoint. It already works. What I want next is to copy multiple ranges from different sheets to the first slide of the template of the newly opened powerpoint. By the way, my sheets are 4 and each has defined ranges to copy. I would like it to paste on the same slide with different positions.
Currently I only have this code to open the powerpoint template:
Sub SPPPT()
'*************Open template in sharepoint*****************************
Dim FullTemplatePath As String
Set PPApp = New PowerPoint.Application
Dim OperationalKPI As Worksheet
Set OperationalKPI = Sheets("OperationalKPI")
Dim mySlide As Object
Dim myShape As Object
Dim PowerPointApp As Object
Dim myPresentation As Object
FullTemplatePath = "FilePathofPowerpointTemplate/PPT Template.pptx"
'Open the PowerPoint template
PPApp.Presentations.Open (FullTemplatePath)
Dim OperationalKPI As Worksheet
Set OperationalKPI = Sheets("OperationalKPI")
Set rng = OperationalKPI.Range("KPIRange")
End Sub
You can paste the data in various formats. There is a good article here on how to do this, in particular the bit about the different file formats that you can paste the data via.
The method pastes it as a shape. Here is some code I use that is similar to the article:
'//Create and open powerpoint
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
'//Set objects and open powerpoint
Dim oPresentation As PowerPoint.Presentation
Dim oTargetSlide As PowerPoint.Slide
Dim oSelect As PowerPoint.ShapeRange
Set oPresentation = ppt.Presentations.Open(sFileName)
'//Copy the data
ThisWorkbook.Sheets("Sheet1").Range("B4:B8").Select
Selection.Copy
'//Paste it into powerpoint
With ppt
Set oTargetSlide = oPresentation.Slides(1)
oTargetSlide.Select
ppt.ActiveWindow.View.GotoSlide oTargetSlide.SlideIndex
Set oSelect =
oTargetSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject)
'//You can now change the .Left, .Top etc of oShape to place it where you want it.
End With
'//Get the save file name....
'... your code here
oPresentation.SaveAs (SaveAsName)
oPresentation.Close
ppt.Quit
I either paste as a ppPasteEnhancedMetafile, ppPastePNG or ppPasteOLEObject.
One key difference with what I am doing is that I am using the PowerPoint 16 object library, rather than just declaring my PowerPoint "as Object".
Details:
Mac Excel (2016) copying to Mac PPT (2016)
Eventually, I would like to loop through all tables and paste each table on its own individual slide in PPT.
But first I'm trying to simply copy one table from Excel and paste to a Specific PPT File (not a net new presentation).
Sub OpenPPTandCopySelectedTable()
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
'Open the specific Template
PPT.Presentations.Open Filename:="/Users/MyNameHere/Downloads/FileName.pptx"
'Make Specific File the Active Presentation
Set PPPres = PPT.ActivePresentation
'Copy the Excel Table
Range("Table1[#All]").Copy
'Select PowerPoint Slide number 2
PPT.Slides(2).Select
'Paste Special
Application.ActiveWindow.View.PasteSpecial DataType:=ppPastePNG
End Sub
What am I doing wrong? Any help would be appreciated.
Try the code below (without using Select and ActivePresentation, which slows down the run-time of your code).
Option Explicit
Sub OpenPPTandCopySelectedTable()
Dim PPT As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim myShape As Object
Set PPT = New PowerPoint.Application
' Open the specific Template and set it (in 1 line)
Set PPPres = PPT.Presentations.Open(Filename:="/Users/MyNameHere/Downloads/FileName.pptx", ReadOnly:=msoFalse)
'Copy the Excel Table
Range("Table1[#All]").Copy
' Paste to PowerPoint and set to MyShape
'Set myShape = PPPres.Slides(2).Shapes.PasteSpecial(ppPastePNG, msoFalse)
' if you want to edit the properties
'With myShape
'.Left =
'.Top =
'End With
' Option 2:
PPPres.Slides(2).Shapes.PasteSpecial (ppPastePNG)
End Sub