Microsoft Powerpoint - Refresh Data for a Chart

Asked By Dan on 07-Dec-11 07:31 AM
I am try to create a macro to select a chart on a slide and refresh the data instead of doing it manually.  I have a macro that selects the slide and that is where I am at.  I want to have the macro select the chart on the slide and "Refresh Data" (I have to manually do this for all the slides that have charts :( ).  Powerpoint 2010 does not have the recorder anymore and I do not not how to make this happen.  Any help in finishing this would be greatly appreciated.

Dan
Anil Kumar replied to Dan on 07-Dec-11 10:41 AM
Hi Dan,

I hope this is what you are looking.

Create a Chart in Excel and update the source data every time you upload new data. Once the Chart gets updated in Excel, you can export the chart in Excel as an image by running this code from a macro. You can then import this image in PowerPoint. This would also ensure that your powerpoint doesn't become 'heavy' plus you can distribute the PPT without being worried that users can see your data.

Sub ExportChart()
 Dim Ws As Worksheet
 Dim ImgName As String
 Dim ChrtNo As Long
 
 '~~> This is your Sheet Name where the chart resides
 '~~> Please change it to the relevant sheetname
 Set Ws = Sheets("Sheet1")
 
 '~~> This is the Chart Number
 ChrtNo = 1
 
 '~~> Name and Path of the Exported Image
 '~~> Please amend as applicable
 ImgName = "C:\Sample.jpg"
 
 Ws.ChartObjects(ChrtNo).Chart.Export _
 Filename:=ImgName, FilterName:="jpg"
End Sub

Note: You have to paste the above code in a module. 
=========================

Also I have a code which can serve the exact purpose but it has a catch, 

CODE:

Dim ppApp As PowerPoint.Application

Dim ppSlide As PowerPoint.Slide



Sub workbook_open()

'

' workbook_open Macro

'



'

 ChDir "S:\AIS\ADS\FDR\FDR Support\Metrics"

 Workbooks.Open Filename:= _

  "S:\AIS\ADS\FDR\FDR Support\Metrics\rfs fund count monthly.xls"

End Sub



Sub ppt_open()



Set ppApp = New PowerPoint.Application

ppApp.Visible = True

ppApp.Presentations.Open Filename:= _

 "S:\AIS\ADS\FDR\FDR Support\Metrics\test\March 2011 Final.ppt"



End Sub



Sub Main()



Dim this As Excel.Workbook

Dim oWB As Excel.Workbook



If Not oWB Is Nothing Then oWB.Close



Set this = ActiveWorkbook

Call workbook_open

Set oWB = ActiveWorkbook



ActiveWorkbook.Sheets("Raw Data").Select

Range("A1:C210").Select

Selection.Copy

Windows("macro.xls").Activate

Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Selection.Columns.AutoFit

Range("A1").Select



Call pivot1



ActiveChart.ChartArea.Copy



Call ppt_open



ppApp.ActivePresentation.Slides(2).Shapes(1).Delete

ppApp.ActivePresentation.Slides(2).Shapes.PasteSpecial



Call pivot2



ActiveChart.ChartArea.Copy

ppApp.ActivePresentation.Slides(3).Shapes(1).Delete

ppApp.ActivePresentation.Slides(3).Shapes.PasteSpecial



MsgBox "End of job", vbInformation, "Finished"



End Sub

Sub pivot1()

'

' pivot Macro

'



 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

  "Sheet1!R1C1:R113C3", Version:=xlPivotTableVersion12).CreatePivotTable _

  TableDestination:="Sheet4!R1C1", TableName:="PivotTable1", DefaultVersion _

  :=xlPivotTableVersion12

 Sheets("Sheet4").Select

 Cells(1, 1).Select

 ActiveSheet.Shapes.AddChart.Select

 ActiveChart.SetSourceData Source:=Range("'Sheet4'!$A$1:$C$18")

 ActiveWorkbook.ShowPivotChartActiveFields = True

 ActiveChart.ChartType = xlColumnClustered

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")

  .Orientation = xlColumnField

  .Position = 1

 End With

 ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _

  "PivotTable1").PivotFields("Number of Funds"), "Sum of Number of Funds", xlSum

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Region")

  .Orientation = xlRowField

  .Position = 1

 End With

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Region")

  .Orientation = xlColumnField

  .Position = 2

 End With

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")

  .Orientation = xlRowField

  .Position = 1

 End With

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")

  .Orientation = xlColumnField

  .Position = 2

 End With

 With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")

  .Orientation = xlRowField

  .Position = 1

 End With

 ActiveChart.PlotArea.Select

 ActiveChart.ChartType = xlColumnStacked

 ActiveChart.Location Where:=xlLocationAsNewSheet



End Sub

Sub pivot2()

'

' pivot2 Macro

'

'

 Windows("macro.xls").Activate

 Sheets("Sheet4").Select

 ActiveSheet.Shapes.AddChart.Select

 ActiveChart.SetSourceData Source:=Range("'Sheet4'!$A$1:$I$19")

 ActiveWorkbook.ShowPivotChartActiveFields = True

 ActiveChart.ChartType = xlLineMarkers

 ActiveChart.SeriesCollection(7).Select

' ActiveChart.ChartArea.Select

 ActiveChart.Location Where:=xlLocationAsNewSheet

End Sub

Module 2:

Sub Button2_Click()



End Sub

Sub reset()

'

' reset Macro

'



'

 Sheets("Sheet1").Select

 Range("A1:C113").Select

 Selection.ClearContents

 Range("A1").Select



MsgBox ""



End Sub

Module 3: (Blank)

Module 4:

Sub pivot_2()

'

' pivot_2 Macro

'



'

 Windows("rfs fund count monthly.xls").Activate

 Windows("macro.xls").Activate

 ActiveSheet.Shapes.AddChart.Select

 ActiveChart.SetSourceData Source:=Range("'Sheet4'!$A$1:$I$19")

 ActiveChart.ChartType = xlLineMarkers

 ActiveChart.PlotArea.Select

 ActiveSheet.ChartObjects("Chart 6").Activate

 ActiveChart.ChartArea.Select

 ActiveSheet.ChartObjects("Chart 6").Activate

End Sub


Above I have a code module:

ppApp.ActivePresentation.Slides(2).Shapes(1).Delete



ppApp.ActivePresentation.Slides(2).Shapes.PasteSpecial







Call pivot2







ActiveChart.ChartArea.Copy



ppApp.ActivePresentation.Slides(3).Shapes(1).Delete



ppApp.ActivePresentation.Slides(3).Shapes.PasteSpecial







MsgBox "End of job", vbInformation, "Finished"







End Sub

 Tried deleting pre-existing graphs inside the powerpoint then paste a new graph in them. This attempt at deleting them doesnt work, so those parts of the code really dont serve any purpose, else it works fine. 



Hope this helps you.
Do update us again.
Thank you.
Anil

Dan replied to Anil Kumar on 07-Dec-11 11:12 AM
Thank you, but that is alot going on.  I just want a macro in PowerPoint (not Excel) to refresh the chart on a slide instead of me doing it manually by selecting the "Refresh Data" at the top.

Dan
Anil Kumar replied to Dan on 07-Dec-11 01:16 PM
Hi Dan,

I have given two solutions, use the code above for the same, The latter one is a heck, I know.
Update me again on this.
Thank you
Anil
Jitendra Faye replied to Dan on 07-Dec-11 10:37 PM
Try this Macro to refresh Chart-

Sub Macro1() 
     '
     ' Macro1 Macro
     ' Macro recorded 3/25/2005 by wbarnett
     '
    Dim intSeries As Integer 
     '
    Range("A1:B5").Select 
    Charts.Add 
    ActiveChart.ChartType = xlBarClustered 
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:B5"), PlotBy:= _ 
    xlRows 
    ActiveChart.Location Where:=xlLocationAsNewSheet 
    ActiveChart.HasLegend = False 
    ActiveChart.SeriesCollection(5).Select 
    With Selection.Border 
        .Weight = xlThin 
        .LineStyle = xlAutomatic 
    End With 
    Selection.Shadow = False 
    Selection.InvertIfNegative = False 
    With Selection.Interior 
        .ColorIndex = 41 
        .Pattern = xlSolid 
    End With 
    ActiveChart.SeriesCollection(4).Select 
    With Selection.Border 
        .Weight = xlThin 
        .LineStyle = xlAutomatic 
    End With 
    Selection.Shadow = False 
    Selection.InvertIfNegative = False 
    With Selection.Interior 
        .ColorIndex = 41 
        .Pattern = xlSolid 
    End With 
     
     ' apply data labels to each series
    With ActiveChart 
        For intSeries = 1 To .SeriesCollection.Count 
            .SeriesCollection(intSeries).ApplyDataLabels AutoText:=True, LegendKey:=False, _ 
            HasLeaderLines:=False, ShowSeriesName:=True, ShowCategoryName:=False, _ 
            ShowValue:=False, ShowPercentage:=False, ShowBubbleSize:=False 
        Next 
    End With 
     
End Sub 



Hope this will help you.
Anoop S replied to Dan on 07-Dec-11 11:28 PM
Try by adding calling this code on selecting chart -> shpGraph.Application.Update
refer this for more details
http://support.microsoft.com/kb/177270
Dan replied to Anoop S on 08-Dec-11 06:36 AM
I guess know understands what I have written.  I do not want to do this from Excel.  leave Excel out.  I am just using PowerPoint, and all I am trying to do is have a chart on a slide "Refresh Data" using a macro.  This way I do not have to go up to the top and manually select the "Refresh Data" button.  Thats it.

Dan
Reena Jain replied to Dan on 08-Dec-11 01:53 PM
HI,

What i will suggest Select the data range then click the ChartWizard button on the toolbar.
Follow directions to create the kind of chart you want.

When you change the data in the range you plotted, the chart will automatically update.