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