I want to paste a named excel range to a content placeholder in powerpoint in a custom layout. I'm currently using code like this
ranger.Copy
currentPPT.ActiveWindow.View.GotoSlide ppt.slides.Count
activeSlide.shapes("Picture").Select msoTrue
ppt.Windows(1).View.PasteSpecial (ppPasteEnhancedMetafile)
It usually works but sometimes fails inexplicably. I have seen elsewhere on this site, here for example, saying to avoid using .Select method. Instead use something like
Dim oSh As Shape
Set oSh = ActivePresentation.Slides(9).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)
However, I can't figure out how to use the second method to copy straight to a content placeholder. Is that possible?
Edit, regarding Shai's suggestion. Current code is
For ii = activeSlide.shapes.Count To 1 Step -1
If activeSlide.shapes.Item(ii).Name = "Picture" Then
shapeInd = ii
Exit For
End If
Next ii
Set oSh = activeSlide.shapes.PasteSpecial(2, msoFalse)(shapeInd)
The "Picture" shape is a "Content" Placeholder. The other two shapes are text boxes.
The code below will do as you mentioned in your post.
First it creates all the necessary PowerPoint objects, including setting the Presentation and PPSlide.
Afterwards, it loops through all Shapes in PPSlide, and when it finds the Shape with Name = "Picture" it retrieves the index of the shape in that sheet, so it can Paste the Range object directly to this Shape (as Placeholder).
Code
Option Explicit
Sub ExporttoPPT()
Dim ranger As Range
Dim PPApp As PowerPoint.Application
Dim PPPres As Presentation
Dim PPSlide As Slide
Dim oSh As Object
Set PPApp = New PowerPoint.Application
Set PPPres = PPApp.Presentations("PPT_TEST") ' <-- change to your open Presentation
Set PPSlide = PPPres.Slides(9)
Set ranger = Worksheets("Sheet1").Range("A1:C5")
ranger.Copy
Dim i As Long, ShapeInd As Long
' loop through all shapes in Slide, check for Shape Name = "Picture"
For i = PPSlide.Shapes.Count To 1 Step -1
If PPSlide.Shapes.Item(i).Name = "Picture" Then
ShapeInd = i '<-- retrieve the index of the searched shape
Exit For
End If
Next i
Set oSh = PPSlide.Shapes.PasteSpecial(2, msoFalse)(ShapeInd) ' ppPasteEnhancedMetafile = 2
End Sub
Related
Sub OO()
Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
Dim oPPShape As Object
Dim FlName As String
'~~> Change this to the relevant file
FlName = "C:\Users\lich_\Documents\test.pptx"
'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
oPPApp.Visible = True
Set oPPPrsn = oPPApp.Presentations.Open(FlName, WithWindow:=msoFalse)
Set oPPSlide = oPPPrsn.Slides(2)
With oPPSlide.Shapes("Chart1").Chart.ChartData
.ActivateChartDataWindow
.Workbook.Worksheets("Sheet1").Range("B2").Value = 0.1231
.Workbook.Close
End With
End Sub
As you can see above, I'm trying to edit the chart data in vba.
But since I have control many charts later, I would like to make the workbook invisible ( or not open it at all if possible )
With oPPSlide.Shapes("Chart1").Chart.ChartData
.ActivateChartDataWindow
.Workbook.Worksheets("Sheet1").Range("B2").Value = 0.1231
.Workbook.Close
End With
In this code I opened by "ActivateChartDataWindow" method and change the data which I want and Closed.
Is there any way to make the window invisible or to edit data without even opening?
Thank you for your help in advance.
It's possible to update existing chart data without Activate as per #mooseman's answer.
However, if the chart is new/inserted at runtime, as far as I know this cannot be accomplished with interop, as the AddChart method adds the chart and simultaneously creates/activates the Excel Workbook. While you may not need to call the Activate method, there is no way to insert or add a new chart that doesn't involve opening an Excel instance. There is no way around this, this is just how the UI functions and it is by design.
To Update Data in EXISTING Chart / ChartData
Below native PowerPoint VBA, but should port easily to Excel with proper reference(s)
Sub test()
Dim PPT As PowerPoint.Application
Dim pres As Presentation
Dim sld As Slide
Dim shp As Shape
Dim cht As Chart
Dim rng As Object ' Excel.Range
Set PPT = Application 'GetObject(,"PowerPoint.Application")
Set pres = ActivePresentation
Set sld = pres.Slides(1)
Set shp = sld.Shapes(1)
Set cht = shp.Chart
Call changeData(cht, 6.3)
pres.Slides.AddSlide pres.Slides.Count + 1, sld.CustomLayout
Set sld = pres.Slides(pres.Slides.Count)
sld.Shapes.AddChart().Chart.ChartData.Workbook.Application.WindowState = -4140
Set cht = sld.Shapes(1).Chart
Call changeData(cht, 3.9)
End Sub
Sub changeData(c As Chart, v As Double)
Dim rng As Object
With c.ChartData
Set rng = .Workbook.Worksheets(1).ListObjects(1).Range
rng.Cells(2, 2).Value = v ' etc.
.Workbook.Close
End With
End Sub
The requirement is to use the With block in VBA.
Some brief tests suggest this is also doable via Interop from python using win32com:
from win32com import client
ppt = client.Dispatch("PowerPoint.Application")
pres = ppt.ActivePresentation
sld = pres.Slides[0]
cht = sld.Shapes[0].Chart
cht.ChartData.Workbook.Worksheets[0].ListObjects[0].Range.Cells(2,2).Value = 9
And also in C#:
using Microsoft.Office.Interop.PowerPoint;
public static void foo(int value = 10)
{
Application ppt = new Microsoft.Office.Interop.PowerPoint.Application();
Presentation pres = ppt.ActivePresentation;
Slide sld = pres.Slides[1];
Chart cht = sld.Shapes[1].Chart;
{
cht.ChartData
.Workbook.Worksheets[1].ListObjects[1].Range.Cells(2, 2).Value = value;
}
}
To Minimize the ChartData / Workbook Window:
In practice I have not had reliable luck using the With method. If you cannot get it to work, then the next-best option is to minimize the window immediately:
Sub changeData(c As Chart, v As Double)
Dim rng As Object
With c.ChartData
.Activate
.Workbook.Application.WindowState = -4140 '## Minimize Excel
'## DO STUFF:
Set rng = .Workbook.Worksheets(1).ListObjects(1).Range
rng.Cells(2, 2).Value = v ' etc.
.Workbook.Close
End With
End Sub
Note that this method does briefly flash Excel on the screen, and this sucks because in that brief instant, it can intercept keystrokes/etc.
You don't have to activate the chartdata worksheet to make changes to it.
With oPPSlide.Shapes("Chart1").Chart.ChartData
'this updates the value in the datasheet
.Workbook.Sheets(1).Range("B2").Value = 0.1231
End with
You can also set the chartdata sheet to equal a range in an excel sheet
path2 = "C:\JohnDoe\Vasquez_061118.xlsm"
Set xlWorkBook = Workbooks.Open(FileName:=path2, ReadOnly:=True)
With oPPSlide.Shapes("Chart1").Chart.ChartData
'this updates the value in the datasheet
.Workbook.Sheets(1).Range("A1:B2").Value = xlWorkBook.Sheets(1).Range("A2:B3").Value
End With
Sub OO()
Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
Dim oPPShape As Object
Dim FlName As String
'~~> Change this to the relevant file
FlName = "C:\Users\lich_\Documents\test.pptx"
'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
oPPApp.Visible = True
Set oPPPrsn = oPPApp.Presentations.Open(FlName, WithWindow:=msoFalse)
Set oPPSlide = oPPPrsn.Slides(2)
With oPPSlide.Shapes("Chart1").Chart.ChartData
.ActivateChartDataWindow
.Workbook.Worksheets("Sheet1").Range("B2").Value = 0.1231
.Workbook.Close
End With
End Sub
As you can see above, I'm trying to edit the chart data in vba.
But since I have control many charts later, I would like to make the workbook invisible ( or not open it at all if possible )
With oPPSlide.Shapes("Chart1").Chart.ChartData
.ActivateChartDataWindow
.Workbook.Worksheets("Sheet1").Range("B2").Value = 0.1231
.Workbook.Close
End With
In this code I opened by "ActivateChartDataWindow" method and change the data which I want and Closed.
Is there any way to make the window invisible or to edit data without even opening?
Thank you for your help in advance.
It's possible to update existing chart data without Activate as per #mooseman's answer.
However, if the chart is new/inserted at runtime, as far as I know this cannot be accomplished with interop, as the AddChart method adds the chart and simultaneously creates/activates the Excel Workbook. While you may not need to call the Activate method, there is no way to insert or add a new chart that doesn't involve opening an Excel instance. There is no way around this, this is just how the UI functions and it is by design.
To Update Data in EXISTING Chart / ChartData
Below native PowerPoint VBA, but should port easily to Excel with proper reference(s)
Sub test()
Dim PPT As PowerPoint.Application
Dim pres As Presentation
Dim sld As Slide
Dim shp As Shape
Dim cht As Chart
Dim rng As Object ' Excel.Range
Set PPT = Application 'GetObject(,"PowerPoint.Application")
Set pres = ActivePresentation
Set sld = pres.Slides(1)
Set shp = sld.Shapes(1)
Set cht = shp.Chart
Call changeData(cht, 6.3)
pres.Slides.AddSlide pres.Slides.Count + 1, sld.CustomLayout
Set sld = pres.Slides(pres.Slides.Count)
sld.Shapes.AddChart().Chart.ChartData.Workbook.Application.WindowState = -4140
Set cht = sld.Shapes(1).Chart
Call changeData(cht, 3.9)
End Sub
Sub changeData(c As Chart, v As Double)
Dim rng As Object
With c.ChartData
Set rng = .Workbook.Worksheets(1).ListObjects(1).Range
rng.Cells(2, 2).Value = v ' etc.
.Workbook.Close
End With
End Sub
The requirement is to use the With block in VBA.
Some brief tests suggest this is also doable via Interop from python using win32com:
from win32com import client
ppt = client.Dispatch("PowerPoint.Application")
pres = ppt.ActivePresentation
sld = pres.Slides[0]
cht = sld.Shapes[0].Chart
cht.ChartData.Workbook.Worksheets[0].ListObjects[0].Range.Cells(2,2).Value = 9
And also in C#:
using Microsoft.Office.Interop.PowerPoint;
public static void foo(int value = 10)
{
Application ppt = new Microsoft.Office.Interop.PowerPoint.Application();
Presentation pres = ppt.ActivePresentation;
Slide sld = pres.Slides[1];
Chart cht = sld.Shapes[1].Chart;
{
cht.ChartData
.Workbook.Worksheets[1].ListObjects[1].Range.Cells(2, 2).Value = value;
}
}
To Minimize the ChartData / Workbook Window:
In practice I have not had reliable luck using the With method. If you cannot get it to work, then the next-best option is to minimize the window immediately:
Sub changeData(c As Chart, v As Double)
Dim rng As Object
With c.ChartData
.Activate
.Workbook.Application.WindowState = -4140 '## Minimize Excel
'## DO STUFF:
Set rng = .Workbook.Worksheets(1).ListObjects(1).Range
rng.Cells(2, 2).Value = v ' etc.
.Workbook.Close
End With
End Sub
Note that this method does briefly flash Excel on the screen, and this sucks because in that brief instant, it can intercept keystrokes/etc.
You don't have to activate the chartdata worksheet to make changes to it.
With oPPSlide.Shapes("Chart1").Chart.ChartData
'this updates the value in the datasheet
.Workbook.Sheets(1).Range("B2").Value = 0.1231
End with
You can also set the chartdata sheet to equal a range in an excel sheet
path2 = "C:\JohnDoe\Vasquez_061118.xlsm"
Set xlWorkBook = Workbooks.Open(FileName:=path2, ReadOnly:=True)
With oPPSlide.Shapes("Chart1").Chart.ChartData
'this updates the value in the datasheet
.Workbook.Sheets(1).Range("A1:B2").Value = xlWorkBook.Sheets(1).Range("A2:B3").Value
End With
I currently am building a table in Excel through automation in PowerShell. This steps works great, the table ends up exactly as I like. I would now like to paste this in to a PowerPoint presentation.
The PowerPoint presentation is a template I have created, which is then filled in with other elements. I think I have every part cracked apart from this one.
I want to paste from the Excel file that is already open in the background. So far it is activated, and desired range selected. It is then pasted in to the PowerPoint window. However, it comes through as a grey table with none of the formatting.
Previously when putting together my template and manually testing the different components, the line below did the paste from Excel and it was perfect.
ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
However, since moving to the automation (and interacting with different windows etc) it no longer works. Instead giving a "cannot create activex component" error.
Full code below:
Function CreateFLUTemplate(templateFile As String, PresPath As Variant, TalkingPointsDoc As Variant, LineOfBusiness As String, PolicyLink As String)
' Declare variables to be used
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim WordApp As Word.Application
Dim PPFile As Object, WordDoc As Object
Dim TitleBox As PowerPoint.Shape, MetricsHeader As PowerPoint.Shape, MetricsTable As PowerPoint.Shape, PhishingHeader As PowerPoint.Shape, PhishingTable As PowerPoint.Shape
Dim PolicyHeader As PowerPoint.Shape, PolicyBox As PowerPoint.Shape, TalkingPointsHeader As PowerPoint.Shape, TalkingPointsBox As PowerPoint.Shape, shp As PowerPoint.Shape
Dim PPSlide As Slide
Dim WAIT As Double
Dim ShapeArray As Variant, LabelsArray As Variant, DateLabel As Variant
Dim i As Integer
' Open blank presentation file to be updated
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
Set PPFile = PPApp.Presentations.Open(PresPath)
Set PPPres = PPApp.ActivePresentation
' Construct date that will be used in the header sections
DateLabel = Format(DateSerial(Year(Date), Month(Date), 0), "d mmmm yyyy")
' Set slide object so we can set our shape variables etc
Set PPSlide = PPPres.Slides(1)
' Copy finished Excel table
' Activate Spreadsheet with table to be copied
Windows(templateFile).Activate
Range("A1:E10").Copy
PPApp.Windows(1).Activate
' Paste Excel table in to PowerPoint
'ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
'PPPres.Slides(1).Shapes.PasteSpecial(DataType:=ppPasteShape).Select
PPApp.ActivePresentation.Slides(1).Shapes.Paste
' Introduce delay to let paste action happen before moving on
WAIT = Timer
While Timer < WAIT + 0.5
DoEvents
Wend
' Take pasted table and save to object
If PPApp.ActiveWindow.Selection.Type = ppSelectionNone Then
MsgBox "Nothing is selected", vbExclamation
Else
For Each shp In PPApp.ActiveWindow.Selection.ShapeRange
Set MetricsTable = PPApp.ActivePresentation.Slides(1).Shapes(shp.Name)
Next shp
End If
' Reposition and resize pasted table.
With MetricsTable
.Left = 27
.Top = 108
.Width = 363
.Table.Columns(1).Width = 148
.Table.Columns(2).Width = 28
.Table.Columns(3).Width = 28
.Table.Columns(4).Width = 28
.Table.Columns(5).Width = 131
.Height = 227
End With
Managed to fix it, can't believe I didn't think to check the code for a very similar action that was already working! I should have been using:
PPPres.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
I am trying to prepare code to copy and paste excel data range from excel sheet to powerpoint slide but I am able to paste images only.
Please help with the suitable code. The code I am using is as follows:
Sub WorkbooktoPowerPoint()
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim Rng As Range
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
Set Rng = ActiveSheet.Range("B1:J31")
Rng.Copy
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Shapes.PasteSpecial ppPasteOLEObject
PPSlide.Shapes(1).Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, True
pp.ActiveWindow.Selection.ShapeRange.Top = 65
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
pp.ActiveWindow.Selection.ShapeRange.Width = 700
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
End Sub
It still surprises me that many of the PasteSpecial options are not available form the clipboard or in PowerPoint generally. I think there is a way around this using a different method. Instead of:
PPSlide.Shapes.PasteSpecial ppPasteOLEObject
Try using this method:
PPSlide.Parent.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
I am not certain of the correct idMso argument to use but I would start with that, it looks like it works the way I would expect it to:
PowerPoint Result
Excel Table Example
If not, there are several others that might be worth checking:
PasteSourceFormatting
PasteDestinationTheme
PasteAsEmbedded
PasteExcelTableSourceFormatting
PasteExcelTableDestinationTableStyle
This method is not as well-documented compared to many other methods. The Application.CommandBars property reference has nary a mention of the ExecuteMso method, which I found some information about here (and on SO where I have seen it used once or twice before):
The full list of idMso parameters to explore, which come as part of a rather large executable for use with fluent ribbon UI design, current for Office 2013 I believe:
http://www.microsoft.com/en-us/download/details.aspx?id=727
Another method for getting the data from Excel to PPT slides without VBA code also possible.
Note: save both workbook and PPT file in one location.
Step 1: Copy excel data / table
Step 2: Go to Power point slides
Step 3: Select Paste special option
Step 4: Select "Paste Link" radio button
Step 5: Click on Ok
Then save the files then change the data in excel, now it will automatically copy the data based linking the connection.
Hope this option helps.
Thanks,
Gourish
To take an Excel range and paste it into a PowerPoint Application, requires breaking down the process into a few different parts. Looking at your code, we can break it down to the following components:
Create an instance of PowerPoint.
Create your slide & presentation.
Create a reference to the range you want to export & then copy it.
Align the shape to the desired dimensions.
Finally, release your objects from memory.
I am assuming that you want this code left as late-binding, but there are also sections of your code that will cause issues because you are treating it like it was written in early-binding.
Also, I have a YouTube video on this topic, so feel free to watch the series if you want to do a more complicated paste or if you're working with multiple Excel Ranges.
Link to Playlist:
https://www.youtube.com/playlist?list=PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN
SECTION ONE: DECLARE THE VARIABLES
Here we will just create all the variables we need in our script.
'Declare PowerPoint Variables
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
'Dim Excel Variables
Dim ExcRng As Range
SECTION TWO: CREATE A NEW INSTANCE OF POWERPOINT
This will create a new PowerPoint application, make it visible and make it the active window.
'Create a new PowerPoint Application and make it visible.
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
SECTION THREE: CREATE A NEW PRESENTATION & SLIDE
This will add a new presentation to the PowerPoint Application, create a new slide in the presentation and set the layout as a blank layout.
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, 12) '<<< THIS 12 MEANS A BLANK LAYOUT.
SECTION FOUR: CREATE A REFERENCE TO THE EXCEL RANGE & COPY IT
This will set a reference to our Excel range we want to copy and copy it.
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
SECTION FOUR: PASTE IN SLIDE AS OLEOBJECT
This will paste the range in the slide and set a reference to it.
'Paste the range in the slide
SET PPTShape = PPTSlide.Shapes.PasteSpecial(10) '<<< 10 means OLEOBJECT
SECTION FIVE: ALIGN THE SHAPE
This will select the shape and set the dimensions of it.
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
SECTION SIX: RELEASE OBJECTS FROM MEMORY
This will release the objects from memory.
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
In full, this is how your code will now look:
Sub ExportRangeToPowerPoint_Late()
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
Dim PPTShape As Object
Dim ExcRng As Range
'Create a new instance of PowerPoint
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
'Paste the range in the slide
Set PPTShape = PPTSlide.Shapes.PasteSpecial(10)
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
End Sub
I have a powerpoint presentation with an excel workbook embedded in one of the slides. I also have a userform that I want the user to input information into, I want to take this information and then edit the excel sheet with the relevant information.
I don't know how to access the excel sheet within powerpoint though so I can change the values of the cells.
Sub a()
Dim oSl As PowerPoint.Slide
Dim oSh As PowerPoint.Shape
Set oSl = ActivePresentation.Slides(1)
Set oSh = oSl.Shapes(1)
With oSh.OLEFormat.Object.Sheets(1)
.Range("A1").Value = .Range("A1").Value + 1
.Range("A2").Value = .Range("A2").Value - 1
End With
Set oSl = Nothing
Set oSh = Nothing
End Sub
Inspired in this code