I have an Excel macro that takes an existing Powerpoint template with chart objects and edits the data for each chart with data from an Excel worksheet. The codes iterates thru 'n' number of rows in worksheet to create a series of 4 slides for each Excel row.
Oddly, for certain rows, one or more slides in the set produces an "Excel has stopped working" error, but the data seems to be installed correctly. However, the problem point is an intermittent and somewhat random "Powerpoint has stopped working" error. The powerpoint error crashes powerpoint entirely. Both seem to occur as I get to around the 50 slide mark or so.
Here is the code for the 4th one in the set as an example. The others are pretty much identical:
oPPT.ActiveWindow.View.GotoSlide Index:=5 + (4 * dIndex)
' SET OBJECT & CHART REFERENCES
Set shapeObject = oPPT.ActivePresentation.Slides(5 + (4 * dIndex)).Shapes("Chart 4")
Set myChart = shapeObject.Chart
Set gChartData = myChart.ChartData
Set gWorkbook = gChartData.Workbook
Set gWorksheet = gWorkbook.Worksheets(1)
' SET VALUES
gWorksheet.Range("B2").Value = myWs.Range("Y" & dRow).Value
gWorksheet.Range("B3").Value = myWs.Range("AA" & dRow).Value
gWorksheet.Range("B4").Value = myWs.Range("Z" & dRow).Value
gWorksheet.Range("B5").Value = myWs.Range("X" & dRow).Value
Set shapeObject = Nothing
Set myChart = Nothing
Set gChartData = Nothing
Set gWorksheet = Nothing
gWorkbook.Close
Set gWorkbook = Nothing
The errors are completely random and occur during different iterations each time. I have found that the 1st time I run never produces the PPT stopped working error. Subsequent ones may.
Any ideas? I am baffled by what is happening here.
Note that I duplicate the template set into as many sets as I need before I iterate the Excel workbook. E.g, if the Excel worksheet has 10 rows, I duplicate the 4 template slides 10 times before doing any edits to the underyling data.
Is there a timing issue going on perhaps?
One thing which seems to be missing is the activation call before accessing the embedded worksheet:
gChartData.Activate
This might explain the crashing issues.
cf. https://msdn.microsoft.com/de-de/vba/powerpoint-vba/articles/chartdata-activate-method-powerpoint
Cheers
Jens
Related
Long story short, I need to maintain a reference table that maps criteria to the slides where these criteria are addressed. Obviously, this is painful since people will be updating PowerPoints until the very last minute.
My goal is to have a macro that can do the following:
I put all PowerPoint files in a given folder (we'll it .../ImportMe)
Run a script that opens each PowerPoint file.
Makes a list of the Slide#'s in column B
Find the Text Box I'm looking for (These all start with "CT:"). Copy the text and paste it into column C for that respective row.
Put the PowerPoint file name in column A for all applicable rows.
I.e. the below...
I have created code that can get me the slide numbers (and I could get the file name, although I have not done it yet). I'm struggling with copying and pasting the data from a specific textbox (or at all, really) -- this is the portion I want to focus on at the moment...
Set xlSheet = Excel.Application.ActiveWorkbook.Sheets("Reference Table")
pptpath = "C:\Users\Username\ImportMe"
Set PP = CreateObject("PowerPoint.Application")
Set pptPres = PP.Presentations.Open(pptpath)
PP.Visible = msoCTrue
For Each pptSlide In pptPres.Slides
'Find new last row
LastRow = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
xlSheet.Range("B" & NewRow).Value = pptSlide.SlideNumber
For Each pptShape In pptSlide.Shapes
If pptShape.TextFrame2.HasText Then
pptText = pptShape.TextFrame2.TextRange.Text
If InStr(1, pptText, "CT:") > 0 Then
'pptShape.TextFrame2.TextRange.Copy
xlSheet.Range("C" & NewRow).Value = pptText
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next pptShape
Next pptSlide
pptPres.Close
This just gives me a blank in column C. My impression is that I'm not looping through the PowerPoint "shapes" correctly. I say that because this because it will correctly put the slide #'s in column B.
Please let me know if you have any questions!
Edit to address comment:
Added additional code
The code is hosted in excel
With ".Value" I get that same exact result
***Important Note: I had an error bypass on (not sure why -- this is dumb when testing code). I turned it off and I am getting error...
Run-time error '-2147024893 (80070003)': Method 'Open' of objection 'Presentations' failed
Which doesn't make any sense because the code is able to open the PP and pull the slide #'s.
I have a workbook which connects to data models through PowerPivot, and the resulting pivot tables are filtered based on a given array collected through a difference process.
Sub AccrualPivot()
'Filter the data for the accrual entries that have been made.
Dim myArray() As Variant
Dim myR As Range
Sheets("Tables").Activate
Sheets("Tables").Range("JournalNum1").Select
Set myR = Sheets("Tables").Range("JournalNum1")
ReDim myArray(0 To myR.Cells.Count - 1)
Sheets("Data").Select
ActiveSheet.PivotTables("AccrualPivot").PivotFields( _
"[Query].[DataEntry].[DataEntry]").ClearAllFilters
ActiveSheet.PivotTables("AccrualPivot").PivotFields( _
"[Query].[JournalNum].[JournalNum]").ClearAllFilters
For i = 0 To myR.Cells.Count - 1
myArray(i) = "[Query].[JournalNum].&[" & myR.Cells(i + 1).Value & "]"
Next i
'ERROR THROWS HERE
ActiveSheet.PivotTables("AccrualPivot").PivotFields( _
"[Query].[JournalNum].[JournalNum]").VisibleItemsList = myArray
'This filters out the Data entries, which need to be included in a separate pivot.
ActiveSheet.PivotTables("AccrualPivot").PivotFields( _
"[Query].[DataEntry].[DataEntry]").CurrentPageName = _
"[Query].[DataEntry].&[0]"
End Sub
The error on the indicated line:
Run-time error '1004': The item could not be found in the OLAP cube.
When I put a watch on this line, both expressions are Variants and myArray has populated with the necessary information. The kicker (and I'm assuming the root) is that this works in my original file. But I need to be able to Save As the workbook to roll over for each month.
I need a file for 4.30, 5.31, etc. If I save the workbook as the following month, change the dates and run everything, it works. But if I close that file, reopen and try to run, I get the 1004 error.
Nowhere in the module do I reference the file name or file path. They're even saved in the same path, just as separate months, and all the sheets are named the same. I'm assuming it's embedded somewhere that I can't find.
I had the same problem, but fiddling with the variable UpdateStr made it work.
There is probably a cleaner way of doing this, but... it worked for me!
Sub FormatTables()
Dim i As Integer
Dim UpdateStr As String
Dim MySheet As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
For i = 1 To ActiveWorkbook.Worksheets.Count
Set MySheet = ActiveWorkbook.Worksheets(i)
If Left(MySheet.name, 7) = "looking for specific sheet names to modify the pivots" Then
For Each pt In MySheet.PivotTables
For Each pf In pt.PivotFields
' I am looping through all fields as I'm doing multiple pivot filtering, and setting different fields to other values... but in this example I only include one field.
If pf.Caption = "CoverageYear" Then
With pf
.ClearAllFilters
UpdateStr = Left(pf.Value, InStrRev(pf.Value, ".")) & "&[2019]"
.CurrentPageName = UpdateStr
End With
End If
Next
pt.RefreshTable
Next
End If
Next i
End Sub
I recently had this error and found Delora Bradish helpful: Rebuild the data model and run the code again.
The powerquery data model is fragile and there are unpredictable consequences when a table is renamed. Also, if you are scripting the model build, the order in which tables are added matters; though tables can be added simultaneously (multi-core processing), and it usually works just fine, sometimes the resulting model misses a table reference somewhere and you get this error. Change the load order to ensure good separation of the big files.
If you are using powerquery, you should have a plan for clean rebuilds of your data model from time to time.
A Visual Management Board at my workplace uses an excel spreadsheet, with many sheets in it, to populate a VMB on a TV. These sheets have many charts in them. I don't work a whole lot in VB so please bear with me.
I'm convinced my problem is because the chart the program is trying to access, literally isn't visible in the excel sheet that pops up. I may just not know what I'm talking about but this seems like a terrible way to get and display data. But I'm supposed to fix it. Here's the sheet that pops up on the screen (I've erased some information for privacy reasons):
Here is an example of the bmp being created when it tries to export a chart that is not visible in the excel window:
From my research, I've found many have resolved this issue by Activating the chart object before exporting it. I tried to do that here, but an exception gets thrown. Here's the entire section of code dealing with the charts and exports to make BMPs that are supposed to reside in the Documents folder:
Dim xlApp As Excel.Application
Dim xlWorkBooks As Excel.Workbooks
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheets As Excel.Sheets
Dim xlWorkSheet As Excel.Worksheet
xlApp = New Excel.Application
xlApp.Visible = True
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Open(ScoreCard)
xlWorkSheets = xlWorkBook.Sheets
For x As Integer = 1 To xlWorkSheets.Count
xlWorkSheet = CType(xlWorkSheets(x), Excel.Worksheet)
If xlWorkSheet.Name = My.Settings.Org Then
xlWorkSheet.ChartObjects(2).chart.Export(Filename:=path + "\Documents\OnTimeDelivery.bmp", FilterName:="BMP")
picOnTimeDelivery.Image = New System.Drawing.Bitmap(path + "\Documents\OnTimeDelivery.bmp")
xlWorkSheet.ChartObjects(3).chart.Export(Filename:=path + "\Documents\Quality.bmp", FilterName:="BMP")
picQuality.Image = New System.Drawing.Bitmap(path + "\Documents\Quality.bmp")
xlWorkSheet.ChartObjects(1).chart.Export(Filename:=path + "\Documents\NoDemandInventory.bmp", FilterName:="BMP")
picNoDemandInventory.Image = New System.Drawing.Bitmap(path + "\Documents\NoDemandInventory.bmp")
xlWorkSheet.ChartObjects(7).chart.Export(Filename:=path + "\Documents\ExcessInventory.bmp", FilterName:="BMP")
picExcessInventory.Image = New System.Drawing.Bitmap(path + "\Documents\ExcessInventory.bmp")
xlWorkSheet.ChartObjects(4).chart.Export(Filename:=path + "\Documents\Freight.bmp", FilterName:="BMP")
picFreight.Image = New System.Drawing.Bitmap(path + "\Documents\Freight.bmp")
xlWorkSheet.ChartObjects(5).chart.Export(Filename:=path + "\Documents\ShortagesByStart.bmp", FilterName:="BMP")
picShortagesByStart.Image = New System.Drawing.Bitmap(path + "\Documents\ShortagesByStart.bmp")
xlWorkSheet.ChartObjects(6).chart.Export(Filename:=path + "\Documents\ShortagesRootCause.bmp", FilterName:="BMP")
picShortagesRootCause.Image = New System.Drawing.Bitmap(path + "\Documents\ShortagesRootCause.bmp")
End If
Runtime.InteropServices.Marshal.FinalReleaseComObject(xlWorkSheet)
Next
xlWorkBook.Close()
xlApp.UserControl = True
xlApp.Quit()
'Close connection to excel sheet
MyConnection.Close()
The program crashes, throwing an Invalid Parameter exception when trying to set
picFreight.Image = New System.Drawing.Bitmap(path + "\Documents\Freight.bmp")
because the Freight.bmp in my documents folder is a 0kb file. If I change what image it's loading next (comment that line out and let it try to load ShortagesByStart.bmp) it crashes for the same reason. All of the charts past this point have one thing in common, they aren't visible on screen. Still this seems like a stupid reason to me; surely something like that wouldn't cause an issue!
First I tried to Activate the xlWorkSheet
xlWorkSheet.Activate()
but this changed nothing.
So I tried to activate the individual ChartObjects by adding
xlWorkSheet.ChartObjects(2).chart.Activate()
xlWorkSheet.ChartObjects(3).chart.Activate()
xlWorkSheet.ChartObjects(1).chart.Activate()
xlWorkSheet.ChartObjects(7).chart.Activate()
xlWorkSheet.ChartObjects(4).chart.Activate()
before the export statements. This actually threw an exception:
So, at this point I'm stuck. How can I activate the chart objects in the worksheet properly? Perhaps there's another problem that's causing this.
So the solution was to update Microsoft Office on whichever PC we wanted to run the VMB from. Corporate creates this Excel spreadsheet with the data on it that this program was trying to display. Eventually, whoever creates this excel sheet got a newer version of Excel, which creates an .xlxs file.
I honestly don't know why the spreadsheet successfully opened in ReadOnly mode, but I suppose there wasn't full support there for Office 2007 and 2010. After upgrading the copy of office on the PC the program created all of the bmps. Weird and I'm sorry if this isn't much of an answer for others but this resolved my issue!
I have the following code:
Option Explicit
Randomize
Dim a, song, album
a = Int((Rnd*195)+1)
song = "B" & a
album = "A" & a
Dim objApp, objWbs, objWorkbook, objSheet
Set objApp = CreateObject("Excel.Application")
Set objWbs = objApp.WorkBooks
objApp.Visible = False
Set objWorkbook = objWbs.Open("C:\Users\Name\Documents\Music.xlsx")
Set objSheet = objWorkbook.Sheets("Sheet1")
song = objSheet.Range(song).Value
album = objSheet.Range(album).Value
objWorkbook.Close False
objWbs.Close
objApp.Quit
Set objSheet = Nothing
Set objWorkbook = Nothing
Set objWbs = Nothing
Set objApp = Nothing
MsgBox("Album name: " & album & vbNewLine & "Song name: " & song)
It prints two random cells between row 1 and row 195 from the Excel sheet "Music". One of them - the one in column A - represents the album, and the other represents the song. The problem is that it takes quite a long time to return the results, about 20 seconds.
I was wondering whether there was a more efficient method I could use to get the results more quickly.
I think Ansgar Wiechers' answer is probably correct that starting Excel is the slowest part of the script. You could try using ADO to connect to the Excel file as if it were a database. This would avoid starting Excel:
Option Explicit
Randomize
Dim conn, rst, song, album
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\Name\Documents\Music.xlsx;" & _
"Extended Properties='Excel 12.0 Xml;HDR=NO';"
' Select a random record; reference https://stackoverflow.com/a/9937263/249624
' Asc(album) is just a way to get some numeric value from the existing data
Set rst = conn.Execute("SELECT TOP 1 F1 AS album, F2 as song FROM [Sheet1$] ORDER BY Rnd(-(100000*Asc(F1))*Time())")
If rst.EOF Then
song = "[NO RECORDS]"
album = "[NO RECORDS]"
Else
song = rst("song").Value
album = rst("album").Value
End If
MsgBox("Album name: " & album & vbNewLine & "Song name: " & song)
The one possible snag here is that VBScript is run by default using the 64-bit version of wscript.exe, and the 64-bit ACE.OLEDB is only available if you installed the 64-bit version of Office 2010 or higher. This can be worked around, though, by running the script with the 32-bit version of wscript.exe (e.g., see How do I run a VBScript in 32-bit mode on a 64-bit machine?).
If you decide to go this route and can control the input Excel file, I would recommend adding a header row to the spreadsheet and changing HDR=NO to HDR=YES in the connection string. That way, you can refer to the columns by name in the query (e.g., SELECT TOP 1 album, song ...) instead of relying on the "F1" syntax.
The most time-consuming steps in your script are most likely
starting Excel and
opening the workbook.
One thing you could do is using an already running Excel instance instead of creating a new one all the time:
quitExcel = False
On Error Resume Next
Set objApp = GetObject(, "Excel.Application")
If Err Then
Set objApp = CreateObject(, "Excel.Application")
quitExcel = True
End If
On Error Goto 0
The variable quitExcel indicates whether you need to close Excel at the end of your script (when you created a new instance) or not (when you used an already running instance).
You could also check if the workbook is already open:
wbOpen = False
For Each wb In objWbs
If wb.Name = "Music.xlsx" Then
Set objWorkbook = wb
wbOpen = True
Exit For
End If
Next
If Not wbOpen Then
Set objWorkbook = objWbs.Open("C:\Users\Name\Documents\Music.xlsx")
End If
Other than that your only options are changing the way the data is stored or buying faster hardware, AFAICS.
Cheran, I disagree with the answers here.
I just ran your script on my 5 year old laptop, and got the answer in about 2 seconds. Whether an instance of Excel was already open made no difference in run time.
(I created a test Music.xlsx spreadsheet by entering "A1" in cell A1, and "B1" in cell B1, and dragged those cells down to row 195 to get a nice set of unique sample data).
Why don't you make Excel visible when it runs, so that you can see for yourself what is going on?
You might see, for example, that Excel takes one second to open, and the Excel Add-ins you have are taking the other fifteen seconds to initialize. It's also possible that your machine and/or hard drive is slow and does indeed take 20 seconds to run this. Who knows...
To get some insight, please make objApp.Visible = True and rerun.
You might also comment out the final eight lines, except for the MsgBox line so that your Excel file stays open after script is done, so that you might see other clues.
Other observations:
1) Your method of opening Excel with CreateObject from a .vbs script seems to be the most reliable/accepted method of automating Excel.
2) It's not stated here HOW you are running the .vbs script (command line vs. double-click from Explorer). Your script is running, but be aware that using cscript.exe to run the .vbs is also common when people try to automate this.
3) I'm not used to seeing an external vbs interact with the data inside Excel...I'm used to having vbs open Excel.xlsm, then letting a Macro do the number crunching. But, Macros bring an entirely different set of headaches. I'm not saying your method is good or bad...just not used to that approach.
Good luck!
I have an Access db to track metrics and "number crunch" data to build PowerPoint presentations. I do about 40 presentations per month, and they are 98% charts.
I run queries one at a time (using SQL statements), take the resulting data and copy it into an Excel template (I made a mock table in this "template" so the chart is already built and formatted), then copy the chart as a picture into a PowerPoint template.
So there is a lot of manual work.
How can I run multiple queries in Access with VBA on the same dataset/table (I have to do sales by quarter, by month, by region, by state, by site and all of these are Top5 aggregate, hence the reasons for the charts), and then send the resulting data to a specific Excel workbook, while defining what goes into what cell range?
If I get all the data into Excel, and have the charts ready to go, is there some VBA that will take the charts from Excel (activeworksheet) and paste them into PowerPoint as pictures in a quad view layout?
Can I do the same thing with an Access to PowerPoint approach and cut out Excel?
I am a novice at best.
You don't need to use Excel at all ! Use MS Access Charts in a report and some VBA code to put them into Powerpoint directly. There is already an example here
One "gotcha" is if you generate graphs in a group ie you design the report with a graph that is inside a group - so when you run the report you will get numerous graphs created.
It is a bit tricky to get hold of each of these graphs and drop them into Powerpoint but here is some code that will take care of it. This works in Access 2003
'Loop through all the controls in this report and pickout all the graphs
For Each c In pReport.Controls
'Graphs initially appear to be in an Object Frame
If TypeOf c Is ObjectFrame Then
'Check the Class of the object to make sure its a Chart
If Left$(c.Class, 13) = "MSGraph.Chart" Then
'Check if this graph must be cloned (required if the graph is in a group in the MS Access report)
If Not IsGraphToBeCloned(pReport.Name, c.ControlName) Then
InsertGraphToPptSlide c, "", pReport.Name
Else
InsertGraphGroupToPpt pReport.Name, c
End If
End If
End If
Next
This will find all the graphs in the report, if the graph is in a group then we call the InsertGraphGroupToPPt function.
The trick here is that we know we have the same base graph multiple times - but populated with different data. So in Powerpoint what you need to do is paste the base graph into powerpoint slides n times - where n is the number of groups and then update the graphs query properties
eg
Function UpdateGraphInPowerpoint(sql As String, OrigGraph As ObjectFrame, Groups As dao.Recordset, GroupName As String, ReportName As String) As Boolean
//Copyright Innova Associates Ltd, 2009
On Error GoTo ERR_CGFF
On Error GoTo ERR_CGFF
Dim oDataSheet As DataSheet
Dim Graph As Graph.Chart
Dim lRowCnt, lColCnt, lValue As Long, CGFF_FldCnt As Integer
Dim CGFF_Rs As dao.Recordset
Dim CGFF_field As dao.Field
Dim CGFF_PwrPntloaded As Boolean
Dim lheight, lwidth, LLeft, lTop As Single
Dim slidenum As Integer
Dim GraphSQL As String
Dim lGrpPos As Long
'Loop thru groups
Do While Not Groups.EOF
'We want content to be added to the end of the presentation - so find out how many slides we already have
slidenum = gPwrPntPres.Slides.Count
OrigGraph.Action = acOLECopy 'Copy to clipboard
slidenum = slidenum + 1 'Increment the Ppt slide number
gPwrPntPres.Slides.Add slidenum, ppLayoutTitleOnly 'Add a Ppt slide
'On Error Resume Next 'Ignore errors related to Graph caption
gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Text = ReportName & vbCrLf & "(" & Groups.Fields(0).Value & ")" 'Set slide title to match graph title
gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Font.Size = 16
gPwrPntPres.Slides(slidenum).Shapes.Paste 'Paste graph into ppt from clipboard
Set Graph = gPwrPntPres.Slides(slidenum).Shapes(2).OLEFormat.Object
Set oDataSheet = Graph.Application.DataSheet ' Set the reference to the datasheet collection.
oDataSheet.Cells.Clear ' Clear the datasheet.
GraphSQL = Replace(sql, "<%WHERE%>", " where " & GroupName & " = '" & Groups.Fields(0).Value & "'")
Set CGFF_Rs = ExecQuery(GraphSQL)
CGFF_FldCnt = 1
' Loop through the fields collection and get the field names.
For Each CGFF_field In CGFF_Rs.Fields
oDataSheet.Cells(1, CGFF_FldCnt).Value = CGFF_Rs.Fields(CGFF_FldCnt - 1).Name
CGFF_FldCnt = CGFF_FldCnt + 1
Next CGFF_field
lRowCnt = 2
' Loop through the recordset.
Do While Not CGFF_Rs.EOF
CGFF_FldCnt = 1
' Put the values for the fields in the datasheet.
For Each CGFF_field In CGFF_Rs.Fields
oDataSheet.Cells(lRowCnt, CGFF_FldCnt).Value = IIf(IsNull(CGFF_field.Value), "", CGFF_field.Value)
CGFF_FldCnt = CGFF_FldCnt + 1
Next CGFF_field
lRowCnt = lRowCnt + 1
CGFF_Rs.MoveNext
Loop
' Update the graph.
Graph.Application.Update
DoEvents
CGFF_Rs.Close
DoEvents
Groups.MoveNext
Loop
UpdateGraphInPowerpoint = True
Exit Function
End Function
Since you are a novice, perhaps you should break the task down into parts and automate the parts one at a time. Each step will provide benefits (i.e. time savings) and you can learn as you go.
It is hard to make specific recommendations based upon lack of specific information (what version etc.). That having been said, perhaps a good first step would be to link the Excel tables to the access queries so that the spreadsheets can auto-update every month and you will not have to cut and paste data from Access into Excel. You can do this linking entirely within Excel.
If you are using Excel 2007 click on "Data" in the Ribbon and then click on "From Access".
What you're asking is a lot of work:
Via VBA you'd have to open Excel (Excel Application manipulation from Access) , update your charts (Range manipulation, Data Update) if you have the rights then I would suggest having your pivot charts connected to the Access data and not pasted into the workbook, nevertheless I've been in enough situations where that was not possible. Then you would have to open your PowerPoint presentation and copy from the Excel to the PowerPoint. I've done all of these and know how much work it can save by creating a macro (via VBA) to do this. It's a lot of code.