Background: I am on the backend of an effort to capture and collate data collected in PowerPoint template form. A template was distributed. The result is ~150 PowerPoint 2010 presentations of ~30 slides each. ~15 of slides in each presentation contain an imbedded XLS.
Benefit to community: Examples of PowerPoint to Excel techniques and in general MS Office techniques vs. solely one MS Office tool.
Problem: I'm only an introductory VBA developer. I seem to find many examples how to get Excel data to PowerPoint, but not much (!) about this seemingly backward approach of data from PowerPoint into Excel. PeltierTech.com gets me close. I found some texts but need a solution before I can get through them.
Need:
1) Loop through all presentations (.PPTX) in a folder (open/close)
2) Inspect each slide in each presentation for an imbedded XLS
3) If found
a) Copy the imbedded source XLS range (not image)
b) Find the last row of the target XLS tab
c) Write the .PPTX name into tab column A
d) Paste the source XLS into target Excel column B
Finally I would prefer the "host" VBA be Excel.
The ideal result is a single .XLSX with ~15 tabs. The resultant data can be scrubbed for unique headers and converted into a pivotable dataset.
This doesn't appear the most to be the most challenging exercise. I think I'm hung on combining the two object models in a single set of procedures. (Yes, the references are correctly set ;-) )
THANK YOU!!!
Here is an example I wrote to extract one chart data from PP file (code is in a excel module). I've commented the code so you will be able to build your own loops to this, but the mechanics of extracting chart data from PP-file via Excel-VBA is as in the following block -
'"Microsoft PowerPoint xx.x Object Library" needed to be installed
'
Sub OpenPPandCopyChartData()
'Create an instance of Powerpoint
Dim PPT As Object
Set PPT = CreateObject(Class:="PowerPoint.Application")
'Open the powerpoint file
Dim pp As PowerPoint.Presentation
Set pp = PPT.Presentations.Open(Filename:=ThisWorkbook.Path & "\Presentation1.pptx", ReadOnly:=msoTrue)
'Select the wanted slide
Dim ps As PowerPoint.slide
Set ps = pp.Slides(1)
'Select the shape
Dim sh As PowerPoint.Shape
Set sh = ps.Shapes(2)
'You can make your own loop to check all the shapes if they contain a chart by using HasChart Method
Debug.Print sh.HasChart = msoTrue
'Select the shape that has chart and activate
sh.Chart.ChartData.Activate
'Set the activated workbook to a variable
Dim wb As Workbook
Set wb = sh.Chart.ChartData.Workbook
'Select the sheet the data is contained
Dim ws As Worksheet
Set ws = wb.Sheets(1)
'Select the range and copy
ws.UsedRange.Copy
'Set where to copy
ThisWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
wb.Close
pp.Close
PPT.Quit
End Sub
The code opens the PPT.file in the same folder that the Excel file is in and selects Slide(1) and Shape(2) from that slide. Then it activates the chart data (if not present this code will cause a subscript out of range error, so on your own code a data checking will be needed) and copies it to the Excel that the sub was started in.
Related
I am using VBA to open the open PowerPoint chart data in Excel and perform a series of actions, such as hiding/deleting rows & columns. I am using the chart.ChartData.Activate command to open the Excel. I had issues in the past with trying to close the workbook immediately after processing, using Workbook.Close(), so I left the Excels open. This has now become an issue with larger presentations and it's causing PowerPoint to crash and open back up in Recovery Mode. Even when I reinstate the Workbook.Close() command, sometimes these instances of Excel still remain open or I lose scope to them inside the routine.
I am processing the presentation on a slide by slide basis so I'm looking for a way to close these open instances all at once, after I'm done processing each slide.
Does anyone know how to access these hanging Excel processes? I've included a picture to better help explain where they reside.
I created an example routine below. I am using the ChartData.ActivateChartDataWindow command instead ChartData.Activate b/c when originally designing this, the Activate command caused the full Excel application to open instead of the ChartDataWindow and tremendously slowed down processing and would sometimes crash when repeated over and over again.
I also added an image of PowerPoint with the ChartDataWindows that are left open by my code.
Private Sub ClearColumnsInExcel()
'Set the slide
Dim slide As slide
Set slide = pptPres.Slides(1)
'Index through each shape on the slide
Dim shapeX As Integer
For shapeX = 1 To slide.Shapes.Count
'If this shape has a chart
If slide.Shapes(shapeX).Type = msoChart Then
'Set the chart
Dim chart As chart
Set chart = slide.Shapes(shapeX).chart
'Set the worksheet
Dim wks As Worksheet
Set wks = chart.ChartData.Workbook.Worksheets(1)
'Activate the workbook
chart.ChartData.ActivateChartDataWindow
'Clear target columns
'Remove objects from memomry
Set wks = Nothing
Set chart = Nothing
End If
Next shapeX
End Sub
I am not sure how you build you code, but you are just closing the workbook. To get the desired outcome, you need to quit the excel application.
I think something like this you do the trick:
Private Sub testSave()
Dim xlsApp As Excel.Application
Dim xlsWbk As Excel.Workbooks
Set xlsApp = New Excel.Application
xlsApp.Visible = True
Set xlswkb = xlsApp.Workbooks.Add 'creating a new wokbook just to test
'do your thing here
xlswkb.Close SaveChanges:=False ' close workbook without saving in this
example
xlsApp.Quit ' quitting the excel app
End Sub
I have a report I create each week that copies a series of charts into a series of slides. Currently, I have VBA code that copies and pastes the charts as images, but the client has asked that the charts be graphic objects so they can inspect the source data from the PPT. Below is a simplified version of the relevant code:
Sub CreatePPT
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Set PP = New PowerPoint.Application
Set PPPres = SCPP.Presentations.Open("C:\filepath\Template.pptx")
PP.Visible = True
'Select the slide I want to paste the chart to (I am not really sure why I need this line, but get an error if I do not have it)
PPPres.Slides(1).Select
'Copy the range where the chart is located
Sheets("Charts").Range("c10:D20").CopyPicture Appearance:=xlScreen, Format:=xlPicture
'Paste the chart to the slide
PPPres.Slides(1).Shapes.Paste.Select
Set PPPres = Nothing
Set PP = Nothing
End Sub
I have tried using paste special, but none of the available data types is anything like the "Paste as Graphic Object" that is available when I manually copy/paste special from excel to ppt manually. Does anyone know it is possible to replicate this type of paste special using VBA? Thanks in advance!
Instead of copying a range (presumably under a chart) as a picture, copy the chart itself, regular copy, not copy picture. Then do a straightforward paste:
Sheets("Charts").ChartObjects("Chart 1").Chart.ChartArea.Copy
PPPres.Slides(1).Shapes.Paste
But if you don't send along the Excel source workbook, and if they don't set up the links properly, they won't be able to view the data in Excel.
I want to create excel worksheets out of a powerpoint presentations where i can keep the format of the powerpoint slides and am able to adjust certain values. Does anyone know a way?
I heard of creating powerpoint slides out of a excel worksheet, though I need to go the other way around as I want to keep the format of the powerpoint slides but need to be able to adjust certain values. Does anyone know a way?
I basically need a Excel worksheet that looks and works like my powerpoint slide.
Here's what I have so far:
Dim PowerPointApp As Object
Dim myPresentation As Object
.
.
.
'Adds a slide to the presentation - is this also possible for worksheets?
Set mySlide = myPresentation.slides.Add(myPresentation.slides.Count + 1, 11) '11 = ppLayoutTitleOnly
' Pastes the copied range out of the excel into the Powerpoint
mySlide.Shapes.PasteSpecial DataType:=2
.
.
.
What I would like to do is to turn these around, I cant find any hints how to. Neither in books nor on the internet.
Here is a rudimentary approach. This code, which is run from within Excel, requires a reference to the powerpoint object library. It creates a new worksheet in Excel, one for each slide, and copies across the slide contents (ie. all the shapes). It positions the shapes per where they are located on the slide. A bit of a concept starter. Cheers.
Option Explicit
' ---> ADD REFERENCE TO MICROSOFT POWERPOINT OBJECT LIBRARY
Public Sub CreateSheetsFromSlides()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As PowerPoint.Presentation
Dim vSlide As PowerPoint.Slide
Dim vPowerpointShape As PowerPoint.Shape
Dim vExcelShape
Dim vSheet As Worksheet
' Open the powerpoint presentation
Set vPowerPoint = New PowerPoint.Application
Set vPresentation = vPowerPoint.Presentations.Open("source.pptx")
' Loop through each powerpoint slide
For Each vSlide In vPresentation.Slides
' Create a new worksheet ... one per slide ... and name the worksheet same as the slide
Set vSheet = ThisWorkbook.Sheets.Add(, After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
vSheet.Name = vSlide.Name
MsgBox vSheet.Name
' Loop through each shape on the powerpoint slide and copy to the new worksheet
For Each vPowerpointShape In vSlide.Shapes
vPowerpointShape.Copy
' Create the shape on the worksheet and position it on the sheet at the same top/left as it is on the slide
vSheet.PasteSpecial
Set vExcelShape = vSheet.Shapes(vSheet.Shapes.Count)
vExcelShape.Top = vPowerpointShape.Top
vExcelShape.Left = vPowerpointShape.Left
Next
Next
vPresentation.Close
vPowerPoint.Quit
End Sub
I am facing troubles with VBA coding.
I have an excel file with various sheets with data and graphs. These graphs are linked to a Powerpoint (graphs have been copied and paste "with link" as objects).
The issue, is that I now have a huge Powerpoint of more than 130 slides with about 18 graphs on each slide... So more than 2000 graphs.
I would like to change the name of my sheets and also to duplicate some slides to populate the graphs with filtered data.
My issue:
- If changing the sheet name, of course the link is broken. Updating everything by hand with the UI is just impossible;
- When duplicating a slide in PowerPoint, the graphs are still linked to the same Excel sheet as the original slide - the only way to change the link is to delete all graphs, duplicate the sheet in Excel - populating with new data - copying-pasting with link again each graph one by one into PowerPoint.
I have tried to use a macro but... it changes the whole address of the link, deleting all sheets information. Is there a way to modifiy the hard address but keeping the same excel file - only changing the sheet?
Here is what I am trying to use to replace the sheet "T3" by the sheet "100s". The macro runs without error but then all the objects are replaced by a copy of the WHOLE "100s" worksheet from my excel file :(
Sub EditPowerPointLinks()
Dim oldFilePath As String
Dim newFilePath As String
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'The old file path as a string (the text to be replaced)
oldFilePath = "\\Server\01xxxx\xxx\xx\X 4.xlsx!T3"
'The new file path as a string (the text to replace with)
newFilePath = "\\Server\01xxxx\xxx\xx\X 4.xlsx!100s"
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedPicture Or pptShape.Type _
= msoLinkedOLEObject Then
'Use Replace to change the oldFilePath to the newFilePath
pptShape.LinkFormat.SourceFullName = Replace(LCase _
(pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)
End If
Next
Next
'Update the links
pptPresentation.UpdateLinks
End Sub
Would anyone have an idea on how to change only the sheet name and keeping all the object names after?
Thanks a lot,
Arthur
In fact, the formula works fine. The replacement of link didn't work because in the original sheet that I copied, the first object in the selection pane was Graph 3. When copying the sheet, Excel automatically tries to make it start at 1 so Graph 3 became Graph 1. Then, when replacing the links, the graphs didn't match.
To make this formula work, make sure in the Selection Pane in Excel that your graphs are named the same way between the original sheet and the new one.
When I try to copy data between worksheets this is no problem, but when I try to copy the same data to a word document it loses its format. Is there a way to stop this?
' Copy all data from 1.xls to new.docx
Sheets("Design").Select
Range("A1:G50").Copy
appWD.Selection.Paste
Could it be something with PasteSpecial?
Thanks.
#Brown
Select Case Range("C19").Value
Case 1
Sheets("Info").Select
Range("B7").Copy Destination:=Sheets("Design").Range("A" & x)
x = x + 2
End Select
So this copies the data from cell C19(Sheet: Info) to cell B7(Sheet: Design)
' I open my word doc etc.
Sheets("Design").Select
Range("A1:E50").Copy
appWD.Selection.Paste
This selects sheet Design, copies everything and pastes this into a word doc. I lose my formatting, I'm also using XP, office 2007.
Here is my simple test program
Sub test()
Dim wrdApp As Word.Application
Set wrdApp = New Word.Application
Dim wrdDoc As Word.Document
wrdApp.Documents.Add
Set wrdDoc = wrdApp.ActiveDocument
Range("A1:B1").Copy
wrdApp.Selection.Paste
wrdDoc.SaveAs "D:\tmp\myworddoc.doc"
End Sub
This works with Office XP (I don't have Office 2007 at hand). Cells A1:B1 contain formatted numbers. This one works fine on my machine, the created word doc contains a table with formatted numbers, too. Can you try it on yours to see if it works?