Solved: Embedded data table in chart query with formatting

[dougbert]

Hi all,

I'm using Office 2010 Professional Plus.

I receive an exported slide set containing just charts and tables from a third-party vendor. So, I have no control over the source.

My first macro copies the charts and tables from the exported slide set to a macro-enabled template. That works just fine.

My second macro (which compiles without errors) then loops through all the shapes on all the slides that have been transferred to the template to position, format, etc. the charts and tables they contain. Oddly, if I step through the macro one line at a time using <F8>, the macro executes flawlessly. However, if I press <F5> to execute this same macro, the code stops "somewhere" within a loop designed to query a chart's embedded data table and format the series data points (bars) with the conditional color.

I'll display the portion of the loop where execution stops "somewhere" in a moment. Since PowerPoint 2007 SP2, MS requires us to first Activate the ChartData member of the Chart class, which opens the embedded data table within Excel. Then, we MUST minimize the activated Excel data table in order to work with its contents. Finally, when we're done working with the embedded data table, we must quit the Excel application that is activated, before working with something like the .Chart.SeriesCollection(1).Points(j) members in the chart itself.

Since my data table query is working in a query/assign/format loop, things happen VERY fast. MY SUSPICION is that I'm opening/minimizing/querying/closing Excel faster than it can handle in a loop. I tried placing a While loop right after the line that minimizes Excel in an attempt to sloooowww things down for Excel. Adding 100 million loops of adding one to 'x' DID slow things down, but execution would still stop on one of the following lines during a RUN.

First, here's the 'portion' of the loop where execution could stop on ANY line, except the color value assignment lines. The errors varied depending upon where execution stopped. However, I don't believe they are actual errors, since manual line by line exection revealed NO errors.

I would appreciate ANY suggestions or observations!!!

The lines in the loop 'portion' of my code where execution might/has stop(ped) randomly:


'Open embedded data table in Excel application
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
'Determine data point value and set color
If .Workbook.Worksheets("Sheet1").Cells(k, 2) < 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) > 0 Then
oBarClr = "Red"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) < 4 Then
oBarClr = "Yellow"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 4 Then
oBarClr = "Green"
End If
.Workbook.Application.Quit


Here is the entire DRAFT version of my code:


Option Explicit
Sub FixUpShapesAndFormatTables()
' This macro removes extra OLE control objects, conditionally formats charts and re-formats tables
Dim lRow As Long
Dim lCol As Long
Dim oSd As Slide
Dim oSp As Shape
Dim oBarClr As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim x As Long
Dim pts As Points
Dim ptsCnt As Long
Dim iNo_of_Rows As Long
' Visit every slide in presentation
For Each oSd In ActivePresentation.Slides
' Check every shape on slide
For Each oSp In oSd.Shapes
With oSp
' If the shape is a msoOLEControlObject, delete the shape
If oSp.Type = msoOLEControlObject Then
oSp.Delete
' Skip to next shape
GoTo NextShape
End If
' Check if shape is a chart
If oSp.Type = msoChart Then
If .Chart.HasTitle = True Then
.Chart.HasTitle = False
End If
If .Chart.HasLegend = True Then
.Chart.HasLegend = False
End If
.Height = 250
'Determine number of points in series
Set pts = .Chart.SeriesCollection(1).Points
ptsCnt = pts.Count
j = 1
'Determine number of rows in data table for chart
With .Chart.ChartData
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(x, 2)) > 0
x = x + 1
Wend
iNo_of_Rows = x - 1
.Workbook.Application.Quit
End With
'Format color for the bars in the chart depending upon data point value from data table
While j <= ptsCnt
For k = 2 To iNo_of_Rows
With .Chart.ChartData
'Open embedded data table in Excel application
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
'Determine data point value and set color
If .Workbook.Worksheets("Sheet1").Cells(k, 2) < 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) > 0 Then
oBarClr = "Red"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) < 4 Then
oBarClr = "Yellow"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 4 Then
oBarClr = "Green"
End If
.Workbook.Application.Quit
End With
'Apply color to data point in series
With .Chart.SeriesCollection(1).Points(j)
If oBarClr = "Red" Then
.Interior.Color = RGB(255, 0, 0) 'red
ElseIf oBarClr = "Yellow" Then
.Interior.Color = RGB(255, 255, 0) 'yellow
Else
.Interior.Color = RGB(0, 255, 0) 'green
End If
'Increment counter to next data point
j = j + 1
End With
Next k
Wend
End If

'Check if shape is a table
If oSp.Type = 19 Then
' Position and resize table
.Top = 80
.Left = 50
.Width = 600
.Height = 0.1
With .Table
' Delete first column
.Columns(1).Delete
' Set remaining column width
.Columns(1).Width = 600
' Go through table by rows and columns
For lRow = 1 To .Rows.Count
For lCol = 1 To .Columns.Count
' Set cell margin
With .Cell(lRow, lCol)
.Shape.TextFrame.MarginLeft = 10
End With
' Format text in cells
With .Cell(lRow, lCol).Shape.TextFrame.TextRange
If lRow = 1 Then
.Font.Bold = msoTrue
.Font.Underline = msoFalse
.Font.Color = vbWhite
.Font.Size = 14
.Font.Name = "Arial"
.ParagraphFormat.Alignment = ppAlignCenter
Else
.Font.Bold = msoFalse
.Font.Underline = msoFalse
.Font.Color = vbBlack
.Font.Size = 12
.Font.Name = "Arial"
.ParagraphFormat.Alignment = ppAlignLeft
End If
End With
Next lCol
Next lRow
End With
End If
End With
NextShape:
Next oSp
NextSlide:
Next oSd
Set pts = Nothing
Set oSp = Nothing
Set oSd = Nothing
End Sub

[dougbert]

I just discovered that I didn't need to open/close the embeddded data table with the chart as often as I did within the loop.

So, I just need to activate the data table once for each chart's data table, minimize it, then close Excel when I'm done with the data table for each chart.

So, here's my revised code which cuts down on the open/closing of Excel, but even with this mod, the macro stops execution randomly within the loop as my first post when I just press <F5> to RUN the macro. However, if I press and hold the <F8> key instead to quickly step through all of the lines, the macro executes normally to the end of the sub. Of course it takes a few minutes, as opposed to the few seconds I hope to be able to accomplish.

Still hoping one of you has a suggestion!


Option Explicit
Sub FixUpShapesAndFormatTables()
' This macro removes extra OLE control objects, conditionally formats charts and re-formats tables
Dim lRow As Long
Dim lCol As Long
Dim oSd As Slide
Dim oSp As Shape
Dim oBarClr As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim x As Long
Dim pts As Points
Dim ptsCnt As Long
Dim iNo_of_Rows As Long
' Visit every slide in presentation
For Each oSd In ActivePresentation.Slides
' Check every shape on slide
For Each oSp In oSd.Shapes
With oSp
' If the shape is a msoOLEControlObject, delete the shape
If oSp.Type = msoOLEControlObject Then
oSp.Delete
' Skip to next shape
GoTo NextShape
End If
' Check if shape is a chart
If oSp.Type = msoChart Then
If .Chart.HasTitle = True Then
.Chart.HasTitle = False
End If
If .Chart.HasLegend = True Then
.Chart.HasLegend = False
End If
.Height = 250
'Determine number of points in series
Set pts = .Chart.SeriesCollection(1).Points
ptsCnt = pts.Count
j = 1
'Determine number of rows in data table for chart
With .Chart.ChartData
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(x, 2)) > 0
x = x + 1
Wend
iNo_of_Rows = x - 1
End With
'Format color for the bars in the chart depending upon data point value from data table
While j <= ptsCnt
For k = 2 To iNo_of_Rows
With .Chart.ChartData
'Determine data point value and set color
If .Workbook.Worksheets("Sheet1").Cells(k, 2) < 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) > 0 Then
oBarClr = "Red"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 3 And .Workbook.Worksheets("Sheet1").Cells(k, 2) < 4 Then
oBarClr = "Yellow"
End If
If .Workbook.Worksheets("Sheet1").Cells(k, 2) >= 4 Then
oBarClr = "Green"
End If
End With
'Apply color to data point in series
With .Chart.SeriesCollection(1).Points(j)
If oBarClr = "Red" Then
.Interior.Color = RGB(255, 0, 0) 'red
ElseIf oBarClr = "Yellow" Then
.Interior.Color = RGB(255, 255, 0) 'yellow
Else
.Interior.Color = RGB(0, 255, 0) 'green
End If
'Increment counter to next data point
j = j + 1
End With
Next k
Wend
With .Chart.ChartData
.Workbook.Application.Quit
End With
End If

'Check if shape is a table
If oSp.Type = 19 Then
' Position and resize table
.Top = 80
.Left = 50
.Width = 600
.Height = 0.1
With .Table
' Delete first column
.Columns(1).Delete
' Set remaining column width
.Columns(1).Width = 600
' Go through table by rows and columns
For lRow = 1 To .Rows.Count
For lCol = 1 To .Columns.Count
' Set cell margin
With .Cell(lRow, lCol)
.Shape.TextFrame.MarginLeft = 10
End With
' Format text in cells
With .Cell(lRow, lCol).Shape.TextFrame.TextRange
If lRow = 1 Then
.Font.Bold = msoTrue
.Font.Underline = msoFalse
.Font.Color = vbWhite
.Font.Size = 14
.Font.Name = "Arial"
.ParagraphFormat.Alignment = ppAlignCenter
Else
.Font.Bold = msoFalse
.Font.Underline = msoFalse
.Font.Color = vbBlack
.Font.Size = 12
.Font.Name = "Arial"
.ParagraphFormat.Alignment = ppAlignLeft
End If
End With
Next lCol
Next lRow
End With
End If
End With
NextShape:
Next oSp
NextSlide:
Next oSd
Set pts = Nothing
Set oSp = Nothing
Set oSd = Nothing
End Sub

[dougbert]

I finished my project. So, I thought I'd at least share my "work-around" for this issue.

I tried:


A Do While Loop: dumb idea as it just ties up the processor
Application.Ontime: as long as I was in an Excel chart, I thought it might work. However, that just ties up Excel, so it can't close and get ready for the next time through the loop.
"Sleep" API: code worked, loop still crashedSo, my "simple" solution was to insert a msgbox right after my .Workbook.Application.Quit line:
MsgBox ("Please press OK to process the next chart!")
That works just fine, as it provides Excel the opportunity to close and get ready for the next chart! Yes, I have to press <Enter> to acknowledge the OK button, but that only occurs 7 times about one second apart during my much larger macro project. Small sacrifice to obtain working code!

I considered adding one of the many automatic "press the OK button after a set delay" subroutines, but decided it wasn't worth it for my project.

I hope someone found a 'nugget' of useful information from my experience.
Marking 'Solved'.

Take care!