dougbert
08-21-2012, 04:43 PM
Hi Guys,
This may very well be a very well-beaten dead horse, but I've got to ask. A fresh pair of eyes may be the answer.
I'm running PowerPoint and Excel 2010.
The macro I'll share below works as is (that's very good). However, it currently requires pressing 'OK' several times on a messagebox I've been forced to utilize. To fully process each chart currently requires acknowledging the messagebox twice per chart.
Background:
Why? I'm manipulating the embedded data table within the embedded charts. Manipulating the data table requires opening and closing Excel. If Excel isn't allowed to completely close before the code continues the macro will abort.
The PowerPoint code has a reference to Excel included.
The first part of the code changes any zeros found in the embedded chart's, embedded data table to "#N/A" in order to displays gaps in the data points. I receive the slide set from a 3rd party vendor. They place zeros into cells with no data rather than just leaving blank.
The "SeriesCollection" part of the code "reformats" the emedded reference notation. Please read the comment in the code just prior to this section for clarification.
After updating the data table, all of the lines in the chart will "disappear" until I exit the datatable, activate the chart, and exit again. I discovered this by manually selecting a "disappeared lines" chart, clicking Edit Data under Chart Tools and closing the Excel data table that pops up. Voila! The lines reappear.
Testing:
I've created a 5 slide presentation with one chart on each slide. The charts progress from slide #1 with a 4-series embedded chart, 5-series...up to an 8-series chart. These are Type 3, msoCharts. Each chart is named "ChartObject", each embedded data table is on its Sheet1.
What I'm hoping for a solution:
Can anyone think of a way to either programatically acknowledge each msgbox with a wait timer that doesn't unduly tie up the processor OR completely do away with the need for the msgbox? Yes, I've tried SendKeys, with the Wait option. It does its job. However, it dismisses the msgbox too quickly, the code continues so fast its trying to open the next instance of Excel before the last instance has a chance to completely close.
Additionally, if you have suggestions for completely different code, I'm open to that as well.
Code:
I'm including just the essential lines of code currently required to perform the task.
Sub ChartObjectSeriesCollectionData()
Dim oSd As Slide
Dim oSp As Shape
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim No_of_Rows As Integer
Dim No_of_Cols As Integer
On Error GoTo 0
' 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 oSp.Type = msoChart Then
'For chart named "ChartObject"
If .Chart.Name = "ChartObject" Then
With .Chart.ChartData
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
'Determine number of rows/columns in data table for chart
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(x, 2)) > 0
x = x + 1
Wend
No_of_Rows = x - 1
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(2, x)) > 0
x = x + 1
Wend
No_of_Cols = x - 1
For k = 2 To No_of_Rows
For j = 2 To No_of_Cols
' If data table cell contains a zero, replace with "#N/A"
' in order to allow gaps when no value exists
If .Workbook.Worksheets("Sheet1").Cells(k, j) = 0 Then
.Workbook.Worksheets("Sheet1").Cells(k, j) = "#N/A"
End If
Next j
Next k
End With
' Close Excel
With .Chart.ChartData
.Workbook.Application.Quit
End With
' DO NOT REMOVE this msgbox, as it is critical to the timing of opening and closing Excel for each chart!
' Full pause to allow Excel to completely close before continuing macro in PowerPoint
' Otherwise, macro will abort
MsgBox ("Please press OK to finish processing the chart!")
' Access seriescollection to re-organize original data table
' The original table referenced contiguous, but discrete cells to represent values in a series
' (e.g.; =Sheet1!$A$2;Sheet1!$A$3;Sheet1!$A$4;Sheet1!$A$5;Sheet1!$A$6;Sheet1!$A$7
' Re-organize data sources as "ranges" instead to allow gaps to display
' SetSourceData and SeriesCollection to: (e.g.; =Sheet1!$A$2:$A$7) via R1C1 format
.Chart.SetSourceData ("'Sheet1'!R1C1:R" & No_of_Rows & "C" & No_of_Cols)
For j = 2 To No_of_Cols
.Chart.SeriesCollection(j - 1).Name = "='Sheet1'!R1C" & j
.Chart.SeriesCollection(j - 1).Values = "='Sheet1'!R2C" & j & ":R" & No_of_Rows & "C" & j
.Chart.SeriesCollection(j - 1).XValues = "='Sheet1'!R2C1:R" & No_of_Rows & "C1"
Next j
' Without this section, charts won't display lines in chart
With .Chart.ChartData
.Activate
.Workbook.Application.WindowState = -4140
.Workbook.Application.Quit
End With
' Pause again to allow Excel to close completely
MsgBox ("Please press OK to process the next chart!")
End If
End If
End With
Next oSp
Next oSd
MsgBox ("All charts have been processed!")
End Sub
Please feel free to ask any questions if I've forgotten to mention something.
Thanks for any response!
This may very well be a very well-beaten dead horse, but I've got to ask. A fresh pair of eyes may be the answer.
I'm running PowerPoint and Excel 2010.
The macro I'll share below works as is (that's very good). However, it currently requires pressing 'OK' several times on a messagebox I've been forced to utilize. To fully process each chart currently requires acknowledging the messagebox twice per chart.
Background:
Why? I'm manipulating the embedded data table within the embedded charts. Manipulating the data table requires opening and closing Excel. If Excel isn't allowed to completely close before the code continues the macro will abort.
The PowerPoint code has a reference to Excel included.
The first part of the code changes any zeros found in the embedded chart's, embedded data table to "#N/A" in order to displays gaps in the data points. I receive the slide set from a 3rd party vendor. They place zeros into cells with no data rather than just leaving blank.
The "SeriesCollection" part of the code "reformats" the emedded reference notation. Please read the comment in the code just prior to this section for clarification.
After updating the data table, all of the lines in the chart will "disappear" until I exit the datatable, activate the chart, and exit again. I discovered this by manually selecting a "disappeared lines" chart, clicking Edit Data under Chart Tools and closing the Excel data table that pops up. Voila! The lines reappear.
Testing:
I've created a 5 slide presentation with one chart on each slide. The charts progress from slide #1 with a 4-series embedded chart, 5-series...up to an 8-series chart. These are Type 3, msoCharts. Each chart is named "ChartObject", each embedded data table is on its Sheet1.
What I'm hoping for a solution:
Can anyone think of a way to either programatically acknowledge each msgbox with a wait timer that doesn't unduly tie up the processor OR completely do away with the need for the msgbox? Yes, I've tried SendKeys, with the Wait option. It does its job. However, it dismisses the msgbox too quickly, the code continues so fast its trying to open the next instance of Excel before the last instance has a chance to completely close.
Additionally, if you have suggestions for completely different code, I'm open to that as well.
Code:
I'm including just the essential lines of code currently required to perform the task.
Sub ChartObjectSeriesCollectionData()
Dim oSd As Slide
Dim oSp As Shape
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim No_of_Rows As Integer
Dim No_of_Cols As Integer
On Error GoTo 0
' 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 oSp.Type = msoChart Then
'For chart named "ChartObject"
If .Chart.Name = "ChartObject" Then
With .Chart.ChartData
.Activate
'Minimize data table (required by MS to manipulate or query table)
.Workbook.Application.WindowState = -4140
'Determine number of rows/columns in data table for chart
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(x, 2)) > 0
x = x + 1
Wend
No_of_Rows = x - 1
x = 1
While Len(.Workbook.Worksheets("Sheet1").Cells(2, x)) > 0
x = x + 1
Wend
No_of_Cols = x - 1
For k = 2 To No_of_Rows
For j = 2 To No_of_Cols
' If data table cell contains a zero, replace with "#N/A"
' in order to allow gaps when no value exists
If .Workbook.Worksheets("Sheet1").Cells(k, j) = 0 Then
.Workbook.Worksheets("Sheet1").Cells(k, j) = "#N/A"
End If
Next j
Next k
End With
' Close Excel
With .Chart.ChartData
.Workbook.Application.Quit
End With
' DO NOT REMOVE this msgbox, as it is critical to the timing of opening and closing Excel for each chart!
' Full pause to allow Excel to completely close before continuing macro in PowerPoint
' Otherwise, macro will abort
MsgBox ("Please press OK to finish processing the chart!")
' Access seriescollection to re-organize original data table
' The original table referenced contiguous, but discrete cells to represent values in a series
' (e.g.; =Sheet1!$A$2;Sheet1!$A$3;Sheet1!$A$4;Sheet1!$A$5;Sheet1!$A$6;Sheet1!$A$7
' Re-organize data sources as "ranges" instead to allow gaps to display
' SetSourceData and SeriesCollection to: (e.g.; =Sheet1!$A$2:$A$7) via R1C1 format
.Chart.SetSourceData ("'Sheet1'!R1C1:R" & No_of_Rows & "C" & No_of_Cols)
For j = 2 To No_of_Cols
.Chart.SeriesCollection(j - 1).Name = "='Sheet1'!R1C" & j
.Chart.SeriesCollection(j - 1).Values = "='Sheet1'!R2C" & j & ":R" & No_of_Rows & "C" & j
.Chart.SeriesCollection(j - 1).XValues = "='Sheet1'!R2C1:R" & No_of_Rows & "C1"
Next j
' Without this section, charts won't display lines in chart
With .Chart.ChartData
.Activate
.Workbook.Application.WindowState = -4140
.Workbook.Application.Quit
End With
' Pause again to allow Excel to close completely
MsgBox ("Please press OK to process the next chart!")
End If
End If
End With
Next oSp
Next oSd
MsgBox ("All charts have been processed!")
End Sub
Please feel free to ask any questions if I've forgotten to mention something.
Thanks for any response!