I need to create a PowerPoint slideshow with graphs. Data source for each graph is an Excel file.
I searched for a similar answer, but none seemed exactly my case.
The presentation is quite long and heavy.
A copy of the presentation (without macros) will be saved as a different file. It needs to be modifiable, so I copied data from Excel to dataChart for each chart in the slideshow.
First and main question: As I try to copy data, I get one of two errors. "Object doesn't support this property or method (Error 438)" or, in some other combinations, "Subscript Out of Range (Error 9)".
Second and minor question: any idea of a better structure for the whole operation?
Private Sub CommandButton1_Click()
Dim sld As Slide
Dim shp As Shape
Call openxcl 'see below
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart = msoTrue Then
With shp
'doing other things
End With
With shp.Chart
.ChartData.Activate
.ChartData.Workbook.Worksheets(1).Cells.Clear
.ChartData.Workbook.Worksheets(1).Range("A1:E6").Paste 'Here I get my error
.ChartTitle.Text = shp.Chart.ChartData.Workbook.Sheets(1).Range("A1").Value
.ChartData.Workbook.Close
End With
End If
Next shp
Next sld
End Sub
Sub openxcl()
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open "C:\path\Source.xlsx", True, False
AppActivate ("Source.xlsx - Excel")
Dim test As Workbook
Set test = ActiveWorkbook
test.Sheets(1).Activate
With test.Sheets(2).Range("A1:E6")
'.Select
.Copy
End With
Set xlApp = Nothing
Set test = Nothing
End Sub
Related
I need to automate moving stuff from excel into PowerPoint. I build put together a macro, which works fine and it is basically running in PowerPoint, accessing Excel, taking some range of nicely formatted tables, and pasting as enhanced metafile:
Function CopyFromExcelToPPT(excelFilePath As String, sheetName As String, rngCopy As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long, Optional shapeHeight As Long, Optional shapeWidth As Long)
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
Set eApp = New Excel.Application
eApp.Visible = False
Set wb = eApp.Workbooks.Open(excelFilePath)
Set ppt = ActivePresentation
'Copy cells in Excel
wb.Sheets(sheetName).Range(rngCopy).Copy
'Paste into first slide in active PowerPoint presentation
ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteEnhancedMetafile
'Close and clean-up Excel
eApp.CutCopyMode = False
wb.Close SaveChanges:=False
eApp.Quit
Set wb = Nothing: Set eApp = Nothing
'Move the new shape if left/top provided
If Not (IsMissing(shapeTop)) Then
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
.Left = shapeLeft
.Top = shapeTop
End With
End If
'Resize the shape if height/width provided
If Not (IsMissing(shapeHeight)) Then
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
.Height = shapeHeight
.Width = shapeWidth
End With
End If
'Put them to the back
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
While .ZOrderPosition > 2
.ZOrder msoSendBackward
Wend
End With
CopyFromExcelToPPT = True
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
CopyFromExcelToPPT = False
End Function
The problem is, that I need to run this like 80x, and after each 5 loads I need to run a macro in that source excel, which will update data. Therefor I tried to either keep excel open during this macro, and manually lunch that macro, or ideally incorporate all of this into this PowerPoint macro.
I tried different approaches, however, I am not able to make it work, I am getting always errors.
Firstly I tried to to create another function handling running macro, and eventually chain it together with main function in main sub:
Function CallTopsheetMacro(excelFilePath As String, sheetName As String)
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application, wb As Excel.Workbook
Set eApp = New Excel.Application
eApp.Visible = True
Set wb = eApp.Workbooks.Open(excelFilePath)
wb.Run "'...\excel.xlsb'!macro_01"
wb.Wait (Now + TimeValue("0:00:10"))
'Close and saves Excel
wb.Close SaveChanges:=True
wb.Wait (Now + TimeValue("0:00:10"))
eApp.Quit
Set wb = Nothing: Set eApp = Nothing
MsgBox ("Done!")
CallTopsheetMacro = True
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
CallTopsheetMacro = False
End Function
But this functions did basically nothing, only opens and closes excel, waiting is not even reflecting. Then I tried with both sessions (main PowerPoint taking the pictures, and excel which is providing pictures and running macros) running, as I would avoid manually triggering macros and wasting time with open/close excels which is pretty bulky:
Function CallTopsheetMacroActive()
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application
Set eApp = GetObject("..\excel.xlsb", "Excel.Application")
eApp.Visible = True
'Run macro
eApp.Run "'...\excel.xlsb'!macro_01"
MsgBox ("Done!")
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
End Function
This one is doing nothing. Then I tried to examine the syntax for GetObject, even with small testing scripts, but it is not working. I have even added references for scrrun.dll, as I have 64bit and it was suggested in couple of similar topics, but of no help. For a simple code like this:
Sub GetObject_Testing()
Dim MyExcel As Excel.Workbook
Dim MySheet As Worksheet
Dim MyFilePath As String
'Set MyExcel = GetObject("Excel.Application")
MyFilePath = "...\excel.xlsb"
Set MyExcel = GetObject(MyFilePath, "Excel.Application")
For Each MySheet In MyExcel.Sheets
Debug.Print MySheet.Name
Next MySheet
End Sub
I am getting run.time error 432 (file name or class name not found during automation operation).
I have no idea what I may be doing wrong, and just to make sure I am providing whole code, just in case I have some error somewhere.
Would appreciate any suggestions which will help to solve this.
PS: Doing this from PowerPoint, because when I tried to the same from Excel, I was getting error that there is not enough memory to start PowerPoint.
Thanks!
With the following code, I'm able to collect data from a slide and sent them to an excel sheet.
Unfortunately, I have some data that are writen in one of the layout of the slide master.
Do you know how can I access to those shapes and collect them in the same excel sheet?
Sub ExportMultiplePowerPointSlidesToExcel()
Dim PPTPres As Presentation
Dim PPTSlide As Slide
Dim PPTShape As Shape
Dim PPTTable As Table
Dim PPTPlaceHolder As PlaceholderFormat
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
Dim xlRange As Excel.Range
'Grab the Currrent Presentation.
Set PPTPres = Application.ActivePresentation
'Keep going if there is an error
On Error Resume Next
'Get the Active instance of Outlook if there is one
Set xlApp = GetObject(, "Excel.Application")
'If Outlook isn't open then create a new instance of Outlook
If Err.Number = 429 Then
'Clear Error
Err.Clear
'Create a new Excel App.
Set xlApp = New Excel.Application
'Make sure it's visible.
xlApp.Visible = True
'Add a new workbook.
Set xlBook = xlApp.Workbooks.Add
'Add a new worksheet.
Set xlWrkSheet = xlBook.Worksheets.Add
End If
'Set the Workbook to the Active
Set xlBook = xlApp.Workbooks("ExportFromPowerPointToExcel.xlsm")
'Set the Worksheet to the Active one, if Excel is already open.
Set xlWrkSheet = xlBook.Worksheets("Slide_Export")
'Loop through each Slide in the Presentation.
Set PPTSlide = ActivePresentation.Slides(1)
'Loop through each Shape in Slide.
For Each PPTShape In PPTSlide.Shapes
'If the Shape is a Table.
If PPTShape.Type = msoPlaceholder Or PPTShape.Type = ppPlaceholderVerticalObject Then
'Grab the Last Row.
Set xlRange = xlWrkSheet.Range("A20").End(xlUp)
'Handle the loops that come after the first, where we need to offset.
If xlRange.Value <> "" Then
'Offset by One rows.
Set xlRange = xlRange.Offset(1, 0)
End If
'Grab different Shape Info and export it to Excel.
xlRange.Value = PPTShape.TextFrame.TextRange
End If
Next
xlWrkSheet.Columns.ColumnWidth = 20
xlWrkSheet.Rows.RowHeight = 20
xlWrkSheet.Cells.HorizontalAlignment = xlLeft
xlApp.ActiveWindow.DisplayGridLines = False
End Sub
Thank you for your precious help
regards,
nicolas
You can access the master slide with the property SlideMaster. The data type is Master (not Slide). It has a Shape collection like a regular slide.
Dim PPTMaster As Master
Set PPTMaster = ActivePresentation.SlideMaster
For Each PPTShape In PPTMaster.Shapes
(...)
Next
If you want to avoid to duplicate your code that handles the shapes, put that part into a subroutine that gets either a single Shape or a Shape-Collection as parameter.
To get content from a particular layout:
Dim objLayout As CustomLayout
For Each objLayout In ActivePresentation.Designs(1).SlideMaster.CustomLayouts
If objLayout.Name = "Layout Name" Then
'Get the information here.
End If
Next objLayout
Even though the property name is CustomLayouts, the same code works for built-in Microsoft slide layouts as well.
I am trying to export each worksheet content (textboxes and shapes, no cellcontent) into a word document. The result is not what I expected. If there are 2 worksheets each one with a text box, 1 text box will be copied twice and the other one won't be copied at all!
Private Sub Export()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
Next ws
End Sub
What I am missing:
Insert a page break after each ws is exported
Understanding why a textbox from a worksheet is copied twice and another textbox from a different worksheet is not copied at all
1. Adding page breaks
If you want to insert a page break at the end of your Word file, you can (1) select the end of the Word content section and (2) insert the page break like this:
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Your code would then look like this:
Private Sub Export_v1()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
2. Avoiding the same text box to be pasted
If you run the above macro, you'll still get the textbox(s) from the first sheet twice. Why? Because you are using Selection.Copy which is dependent on which sheet is active.
To make sure that the correct sheet is active, simply add ws.Activate before selecting the shapes like this:
Private Sub Export_v2()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
3. Potential improvements
3.1 Avoid using Select inside Excel
Avoiding using Select in Excel VBA can lead to major speed improvements. However, in this case you can't just replace
ws.Shapes.SelectAll
Selection.Copy
with
ws.Shapes.Copy
as it won't copy the shapes. Instead, you would need to loop through each shape in the worksheet to paste them one by one. This might introduce more complications to your code, so if speed is not an issue, you could keep it as this.
3.2 Reset objects to nothing
To avoid Excel running out of memory, it is a good practice to always reset objects to nothing after you are done using them (at the end of your procedure in this case):
Set WordApp = Nothing
I'm trying to automate the creation of a PowerPoint deck that I create a few times a week. I use a program called Alteryx to update the embedded excel files for all my charts in PowerPoint and that part works great. The problem that I have is that once I open PowerPoint, all the charts look the same as they originally were. It's only when I click edit data, that PowerPoint seems to read the excel changes and updates the chart. I have over 50 charts that I need to update, and clicking edit data on each one is very time consuming.
Is there a macro that can be created that will refresh all charts in my deck?
Thank you in advance for your time!
Update 1
I have tried using the following code from another post, but it results in 50 open workbooks.
Dim pptChart As Chart
Dim pptChartData As ChartData
Dim pptWorkbook As Object
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set pptChart = shp.Chart
Set pptChartData = pptChart.ChartData
pptChartData.Activate
shp.Chart.REFRESH
On Error Resume Next
On Error GoTo 0
End If
Next
Next
Set pptWorkbook = Nothing
Set pptChartData = Nothing
Set pptChart = Nothing
I tried using the following code to open and close all the embedded workbooks, but it results in an error at this part "ActiveWindow.View.GotoSlide s.Slideindex"
Sub refreshchart()
Dim ppApp As PowerPoint.Application, sld As Slide
Dim s As PowerPoint.Shape
Dim gChart As Chart, i As Integer
ppApp.Visible = True
i = 3
Set sld = ActivePresentation.Slides(i)
sld.Select
For Each s In ActivePresentation.Slides(i)
If s.Type = msoEmbeddedOLEObject Then
s.Select 'select the object
s.OLEFormat.Activate 'Activate it (like 2x click))
ActiveWindow.Selection.Unselect 'To let it close
ActiveWindow.View.GotoSlide s.Slideindex 'make current slide active
End If
Next s
End Sub
A macro that opens the workbooks to refresh the charts and automatically closes them would be great. Thank you!
so far I have tried the Chart.Refresh and Chart.Update and also ChartData.UpdateLinks and neither work.
My question is similar to this one only that this code did not work for my ppt
How to update excel embedded charts in powerpoint?
If i could Record Macro like in Excel the steps would be:
Select Chart
Chart Tools > Refresh Data
This is code is what I have managed to write but it fails at "gChart.Application.RefreshData":
Sub refreshchart()
Dim ppApp As PowerPoint.Application, sld As Slide
Dim s As PowerPoint.Shape
Dim gChart As Chart, i As Integer
ppApp.Visible = True
i = 3
Set sld = ActivePresentation.Slides(i)
sld.Select
For Each s In ActivePresentation.Slides(i)
If s.Type = msoEmbeddedOLEObject Then
Set gChart = s.OLEFormat.Object
With gChart.Application
gChart.Application.Refresh
Set gChart = Nothing
End If
Next s
End Sub
The Integer i is included to go from i=1 To 73, but as a test i am using Slide 3. Not all Slides have Charts but most of them have 4 Charts (65 out of 73).
I changed the code a little bit and with this little change, the refresh of the charts works again automatically.
Many times, if you share your excel ppt combo the links break and after restoring them the automated chart refresh doesn`t work.
With the downstanding macro the automated refresh will work again:
Sub REFRESH()
Dim pptChart As Chart
Dim pptChartData As ChartData
Dim pptWorkbook As Object
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set pptChart = shp.Chart
Set pptChartData = pptChart.ChartData
pptChartData.Activate
shp.Chart.REFRESH
On Error Resume Next
On Error GoTo 0
End If
Next
Next
Set pptWorkbook = Nothing
Set pptChartData = Nothing
Set pptChart = Nothing
End Sub
The code below is in a macro in the Excel workbook which also contains the source data. Not sure if the code would be the same running it from PowerPoint. I simply open my Excel Workbook and then have it update the PowerPoint for me.
I have been looking forever to find an answer to this and finally managed to get it to work with a ton of reading and trial-and-error. My problem was that I have a PowerPoint with a lot of graphs that were created with CTRL+C and CTRL+V, so none of them are linked.
This is how I got it to work:
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart
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
End If
Next
Next
I don't know if there is unnecessary code in there but I am just happy that I finally got it to work so I'm not touching it anymore.
This code worked. But it works only if both files are open (the excel if its only one): The Power Point and the Excel with the data. It actually Refreshes all charts one by one.
Sub updatelinks()
Dim sld As Slide, shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
On Error Resume Next
shp.LinkFormat.Update
Next
Next
MsgBox ("Graficos actualizados con éxito")
End Sub
So, If the Excel is on a shared location, the code wont work because it takes too much time to retrieve the data. Im still looking for a way to do this. Thanks!
This may help, It opens and closes the embedded Excel object
For Each s In ActivePresentation.Slides(i)
If s.Type = msoEmbeddedOLEObject Then
s.Select 'select the object
s.OLEFormat.Activate 'Activate it (like 2x click))
ActiveWindow.Selection.Unselect 'To let it close
ActiveWindow.View.GotoSlide s.Slideindex 'make current slide active
End If
Next s