Consulting

Results 1 to 1 of 1

Thread: Manipulating embedded msoChart in PowerPoint

  1. #1
    VBAX Regular
    Joined
    Jul 2011
    Posts
    40
    Location

    Question Manipulating embedded msoChart in PowerPoint

    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.

    [vba]
    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
    [/vba]

    Please feel free to ask any questions if I've forgotten to mention something.

    Thanks for any response!
    Last edited by dougbert; 08-21-2012 at 05:13 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •