I am trying to paste an msoChart object with embedded data from the clipboard into PowerPoint 2010 using VBA. (chart created in Excel 2010).
The only examples that I can find involve either linking the Chart to an Excel file or creating a msoEmbeddedOLEObject.
If I manually paste in PowerPoint 2010 I get a paste option to "Embed Workbook". However it is not available within manual "Paste Special".
So it would seem that something in addition to pasting the chart is needed. But I am unsure what that is or how to go about it.
What I have tried is
Sub PasteExample()
Dim Sld As Slide
Dim Shp As ShapeRange
Set Sld = ActiveWindow.View.Slide
'# This pastes clipboard content as a linked chart
Set Shp = Sld.Shapes.Paste
End Sub
Sub PasteExample2()
Dim Sld As Slide
Dim Shp As ShapeRange
Set Sld = ActiveWindow.View.Slide
'# This option does not work, object is still linked
'Set Shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteDefault, Link:=msoFalse)
'# This option does not work, object is still linked
'Set Shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteShape, Link:=msoFalse)
'# I'm not after OLEObjects
'Set Shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)
End Sub
Many thanks if you can shed some light.
We don't see what you are copying and how, plz join code if problem not solved
Here are the members of PpPasteDataType that you can use with PasteSpecial in PowerPoint :
Usually, I use that code as a base, it should help you :
Sub Export_to_Ppt()
'
Dim Ppt As PowerPoint.Application, _
Pres As PowerPoint.Presentation
Set Ppt = CreateObject("PowerPoint.Application")
Set Pres = Ppt.Presentations.Open("I:\Template DTC.potx")
Ppt.Visible = True
Sheets("Graph1").ActiveChart.ChartArea.Copy
Pres.Slides.Add Index:=Pres.Slides.Count + 1, Layout:=ppLayoutTitleOnly
'Pres.Slides(Pres.Slides.Count).Shapes.Paste
Pres.Slides(Pres.Slides.Count).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=False
Pres.Slides(Pres.Slides.Count).Shapes.Title.TextFrame.TextRange.Text = "Chart Title"
Pres.SaveAs _
Filename:="I:\TestNaz.ppt", _
FileFormat:=ppSaveAsOpenXMLPresentation
Set Ppt = Nothing
Set Pres = Nothing
End Sub
I tried to reproduce your example with PowerPoint 2013. I wasn't able to reproduce the behaviour that you describe.
Pre-Condition: I copied an Excel 2013 chart to the Clipboard (just the chart, not the whole worksheet or anything else).
Invoking either Sld.Shapes.Paste or Sld.Shapes.PasteSpecial(DataType:=ppPasteDefault,Link:=msoFalse) will insert an msoChart into Powerpoint:
Set shp = Sld.Shapes.Paste
MsgBox shp.Type ' returns 3 that is msoChart
Set shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteDefault, Link:=msoFalse)
MsgBox shp.Type 'returns 3 that is msoChart
Those charts are properly formatted in the current PowerPoint style and I can right-click them to edit the data.
Especially, they are embedded, not linked.
For comparison I also tried:
Set shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)
MsgBox shp.Type ' returns 7 that is msoEmbeddedOLEObject
Set shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoTrue)
MsgBox shp.Type ' returns 10 that is msoLinkedOLEObject
Set shp = Sld.Shapes.PasteSpecial(DataType:=ppPasteDefault, Link:=msoTrue)
MsgBox shp.Type 'returns 10 that is msoLinkedOLEObject
When I right-click those in Powerpoint, then there is are menu entries to manipulate the “Worksheed Object” respectively the “Linked Worksheed Object”.
So either I misunderstand what you mean by "linked", or there is a bug in PP 2010, or you are having something different in your clipboard.
I did come upon a solution on another form.
Once the chart is in the clipboard.
Execute the following line in PowerPoint 2010
Application.CommandBars.ExecuteMso "PasteExcelChartDestinationTheme"
It gave me just what I was after.
Related
I have been able to, with support from site members, create a user form in a Power Point slide to update an embedded chart. In order to fully utilize the user form, VB code must used to loop through all slides because the named chart may move between slides. The name of the chart is "DVPVchart". The code being used continues to get an error at the first Set assignment. Code is below. Tried multiple arrangements and variants of the loop but continue to return the same error. Any guidance is appreciated.
Private Sub AddDVSetUp_Click()
Dim sld As slide
Dim shp As shape
Dim chrt As Chart
Dim xlWB As Object
For Each sld In ActivePresentation.Slides
Set shp = sld.Shapes("DVPVchart")
Set xlWB = shp.Chart.ChartData.Workbook
'Find first sheet of embedded Chart In PowerPoint
With xlWB.Sheets(1)
'location in Chart In PowerPoint = UserForm Textbox
.Range("C4").Value = Gate2Date.Value
.Range("C11").Value = OldestSurrogateDate.Value
End With
Next sld
End Sub
It returns error since you didn't put a check if the chart exist in the said slide. You need to add a check if the chart matches your criteria. Try:
For Each sld In ActivePresentation.Slides
'/* You will need another loop to check each shape */
For Each shp In sld.Shapes
If shp.Type = msoChart Then '/* check for specific type of shape */
If shp.Name = "DVPVchart" Then '/* chech chart for specific name */
Set xlWB = shp.Chart.ChartData.Workbook '/* assign it */
Exit For '/* exit since you got what you need */
End If
End If
Next
If Not xlWB Is Nothing Then Exit For '/* exit if you already set your xlWB object
Next
'/* Rest of your code go here */
I have an Excel file that contains a column with images that correspond to distinct unique IDs. Basically, through VBA, I want to loop through each image and save it with its name being the unique ID.
I realize you cannot save an image in Excel itself, so I found this VBA code online (found below) that copies the image into PowerPoint and saves it there, but it is not working for me. I am working with Excel 2016, 64 bit.
Any suggestions?
Sub SaveImages()
'the location to save all the images
Const destFolder = "C:\Desktop\Images"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("data")
Dim ppt As Object, ps As Variant, slide As Variant
Set ppt = CreateObject("PowerPoint.application")
Set ps = ppt.presentations.Add
Set slide = ps.slides.Add(1, 1)
Dim shp As Shape, shpName
For Each shp In ws.Shapes
shpName = destFolder & shp.TopLeftCell.Offset(0, 1) & ".png"
shp.Copy
With slide
.Shapes.Paste
'This is the point where the code breaks, when I try to save
.Shapes.SaveAs Filename:=destFolder & shpName
.Shapes(.Shapes.Count).Delete
End With
Next shp
With ps
.Saved = True
.Close
End With
ppt.Quit
Set ppt = Nothing
End Sub
So I'm trying to get a table deleted from a powerpoint that is opened using VBa, and I can't seem to get it to work. I've tried a few things but they never have any effect or usually just give me an error.
So far I have gotten the following, which opens a specific powerpoint and copies in a specific table to the first slide. I really would like to be able to delete the table that is already there and replace it with the new one.
How would I go about doing this? Code below:
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("Table1[#ALL]")
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Open("Y:\Projects\VBa\vbatest2.pptx")
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Item(1)
'Delete current table in presentation
'ActivePresentation.Slides(1).Shapes(1).Delete
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShapeRange.Left = 20
myShapeRange.Top = 100
myShapeRange.Height = 400
myShapeRange.Width = 900
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
myPresentation.Slides(1).Shapes(1).Delete
Place code above just after
Set mySlide = myPresentation.Slides.Item(1)
When I used this it deleted my table from my powerpoint however it was only a table in the slide, you may need to change the number in shapes to get this to work for you. I also don't know how it will fair will continued use, you may need to keep changing the number.
I used This link
to find out how to delete items from powerpoint
ActivePresentation.Slides(2).Shapes(5).Table.Rows(3).Delete
Is the origonal code from the site linked and was adapted using trial and error
This link
Explains shapes a bit more, hope it helps. In a basic overview it basicly says that in powerpoint most items you can enter in it are called shapes
If you want me to explain anything further just leave a comment and I shall try to do so
Try calling this function to delete all tables from the specified slide:
Option Explicit
' Deletes all tables from the specified slide (table shapes and tables within placeholders)
' Returns the number of tables deleted
' Written by Jamie Garroch of YOUpresent Ltd. (http://youpresent.co.uk)
Public Function DeleteTablesFromSlide(mySlide As PowerPoint.Slide) As Long
Dim lCntr As Long
Dim lTables As Long
' Count backwards when deleting items from a collection
For lCntr = mySlide.Shapes.Count To 1 Step -1
With mySlide.Shapes(lCntr)
Select Case .Type
Case msoTable: .Delete: lTables = lTables + 1 ' msoTable = 19
Case msoPlaceholder ' msoPlaceholder = 19
If .PlaceholderFormat.ContainedType = msoTable Then .Delete: lTables = lTables + 1
End Select
End With
Next
DeleteTablesFromSlide = lTables
End Function
Call with:
DeleteTablesFromSlide mySlide
All I want to do is copy a range from Excel and then paste this range into PowerPoint.
When my range is manually copied from Excel to the clipboard... If I right click on a blank slide when pasting into PowerPoint, it gives me the option to paste "using destination styles".
This means that I can edit the resulting table. This is the result I want.
So far I have only found solutions which involve pasting in as a metafile.
If you have a solution please can you show me the full code including the dimensions as VBA in PowerPoint really isn't my cup of tea.
Thanks in advance for restoring my sanity!
Private Sub CommandButton2_Click()
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Show the PowerPoint
newPowerPoint.Visible = True
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.count)
ActiveSheet.Range("d51:d57").Copy
activeSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 165
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 395
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing
End Sub
There appears to be no corresponding method in the PowerPoint object model. The only way to do this is to call the ribbon button itself:
ActiveSheet.Range("d51:d57").Copy
newPowerPoint.CommandBars.ExecuteMso("PasteExcelTableSourceFormatting")
BTW: To find the list of ribbon buttons, search for "Office 2010 Control IDs".
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