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
Related
I need to extract data from text boxes in a PowerPoint presentation and put them in respective cells in an Excel worksheet.
I have searched but can't find a suitable work-around.
This code is to print the text from slides. I can't understand how to arrange it in Excel cells.
Dim oPApp As Object
Dim oSlide As Object
Dim oShape As Object
Set oPApp = GetObject(, "PowerPoint.Application")
For Each oSlide In oPApp.ActivePresentation.Slides
For Each oShape In oSlide.Shapes
If oShape.Type = 1 Or oShape.Type = 14 Then
Debug.Print oShape.TextFrame.TextRange.Text
End If
Next oShape
Next oSlide
Set oPApp = Nothing
Example of slide (Input):
Example of sheet (Output):
Supposing you want it to be done from Excel module (it could be done from PowerPoint Module also), I just adding some codes & suggestions to your code. However it is to be mentioned while looping through Shapes in a PowerPoint Slide It generally comes in order of creation of the shape. So for maintaining proper sequence of the fields, you have to work out some way sort them according to their position (i.e. top, left property or any other criteria according to the presentation). Try
Dim oPApp As Object
Dim oSlide As Object
Dim oShape As Object
Dim Rw, StCol, Col, Sht As Long
Rw = 2 'Starting Row of Target excel data
StCol = 1 'Starting Column of Target excel data
Sht = 3 'Target Worksheet no.
Set oPApp = GetObject(, "PowerPoint.Application")
'It will only work for already opened active presentation
'It can also be suugested that first create a powerpoint object and then open desired preesntation fron the path
For Each oSlide In oPApp.ActivePresentation.Slides
Col = StCol
For Each oShape In oSlide.Shapes
If oShape.Type = 1 Or oShape.Type = 14 Then
' Debug.Print oShape.TextFrame.TextRange.Text
'Next line was added for putting the data into excel sheet
ThisWorkbook.Sheets(Sht).Cells(Rw, Col).Value =
oShape.TextFrame.TextRange.Text
End If
Col = Col + 1
Next oShape
Rw = Rw + 1
Next oSlide
Set oPApp = Nothing
however one word of caution msoTextBox type is 17 and type 14 is msoPlaceholder.
I have a PowerPoint with links from multiple Excel spreadsheets. I would like to update the linked object with a macro.
The macro below will generate 2 types of popup. Popup will appear for each link to be updated in my case about 30 times. Clicking cancel will allow macro to continue.
1) Microsoft Excel has stopped working (close program)
2) File in use (Read Only, Notify, or Cancel options)
Is there a way to bypass these messages?
Sub linkupdate()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
If LCase(oshp.LinkFormat.SourceFullName) Like "*defect 95R*" Then
oshp.LinkFormat.AutoUpdate = ppUpdateOptionManual
oshp.LinkFormat.Update
oshp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
End If
End If
Next
Next
MsgBox "Finished updating Charts", , "Update Complete"
End Sub
This code prevented the following alerts from occurring
1) Microsoft Excel has stopped working (close program)
2) File in use (Read Only, Notify, or Cancel options)
After completion macro popup it can take a minute before the user gains control of PowerPoint. I'm assuming excel alerts are being closed in the background as there are over 30 link charts.
I'm a newbie at VBA so this code may not be efficient.
Sub linkUpdate()
Const xFile = "C:\temp\defect 95R.xlsx"
Dim pptPresentation As Presentation
Dim osld As Slide
Dim oshp As PowerPoint.Shape
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Open xFile, ReadOnly:=True, Notify:=False
xlApp.Workbooks.Application.DisplayAlerts = False
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each osld In pptPresentation.Slides
'Loop through each shape in each slide
For Each oshp In osld.Shapes
'Find out if the shape is a msoLinkedOLEObject type=10
If oshp.Type = msoLinkedOLEObject Then
'Only update shape if file name contains defect 95r
If LCase(oshp.LinkFormat.SourceFullName) Like "*defect 95r*" Then
oshp.LinkFormat.AutoUpdate = ppUpdateOptionManual
xlApp.Workbooks.Application.DisplayAlerts = False
oshp.LinkFormat.Update
oshp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
End If
End If
Next
Next
xlApp.Workbooks.Close
xlApp.Workbooks.Application.Quit
Set xlApp = Nothing
MsgBox "Finished updating Charts", , "Update Complete"
End Sub
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
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
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.