VBA Powerpoint - Atualizando gráfico com dados do MS Excel

| Blog Office VBA | Blog Excel | Blog Access |

Atualize o gráfico no MS Powerpoint através de dados em planilha MS Excel.

'Code by Mahipal Padigela
'Open Microsoft Powerpoint,Choose/Insert a Graph type Slide(No.8), then double click to add a graph and click...
'...outside the graph to close the Datasheet, then rename the Graph to "Mychart",Save and Close the Presentation
'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some test data...
'...(numbers between 0-100) in Rows 2,3,4 and Columns B,C,D,E).
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references)
'Reference 'Microsoft Graph Object Library' (VBA IDE-->tools-->references)
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier.
'Change "strNewPresPath" to where you want to save the new Presnetation to be created later
'Close VB Editor and run this Macro from Excel window(Alt+F8)

 Dim oPPTApp As PowerPoint.Application

Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
Public oGraph As Graph.Chart
Dim SlideNum As Integer
 Sub PPGraphMacro()

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String strPresPath = "H:\PowerPoint\Presentation1.ppt" strNewPresPath = "H:\PowerPoint\New1.ppt"  Set oPPTApp = CreateObject("PowerPoint.Application") oPPTApp.Visible = msoTrue Set oPPTFile = oPPTApp.Presentations.Open(strPresPath) SlideNum = 1 oPPTFile.Slides(SlideNum).Select Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Mychart") Set oGraph = oPPTShape.OLEFormat.Object  Sheets("Sheet1").Activate oGraph.Application.DataSheet.Range("A1").Value = Cells(2, 2).Value oGraph.Application.DataSheet.Range("A2").Value = Cells(3, 2).Value oGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).Value oGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).Value oGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).Value oGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).Value oGraph.Application.DataSheet.Range("D2").Value = Cells(3, 5).Value oGraph.Application.DataSheet.Range("D3").Value = Cells(4, 5).Value 

'Should you need to access the Graph axes to turn them On/Off or to set ranges etc etc...use this'

oGraph.HasAxis(xlValue, xlPrimary) = True ' Shows Y-axis on the graph' Set oAxis = oGraph.Axes(xlValue)' With oAxis' .MinimumScale = 0' .MaximumScale = 1.2' End With' oGraph.HasAxis(xlValue, xlPrimary) = False ' Hides Y-axis on the graph

'Should you need to access the Graph's Markers to change their Color based on Data at...'...runtime etc...use this(Not applicable to the graph in this example but to Graphs with Markers like..'... Bubble, Line etc. Scatter charts)'

Dim i as Integer' For i = 1 To oGraph.SeriesCollection(1).Points.Count' If oGraph.Application.DataSheet.Cells(i, 2).Value >= 50 Then' oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 3' oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 3' Else' oGraph.SeriesCollection(1).Points(i).MarkerBackgroundColorIndex = 6' oGraph.SeriesCollection(1).Points(i).MarkerForegroundColorIndex = 6' End If' Next i  oGraph.Application.Update oGraph.Application.Quit  oPPTFile.SaveAs strNewPresPath oPPTFile.Close oPPTApp.Quit  Set oGraph = Nothing Set oPPTShape = Nothing Set oPPTFile = Nothing Set oPPTApp = Nothing MsgBox "Presentation Created", vbOKOnly + vbInformation

End Sub

Tags: VBA, Powerpoint, Excel, export, chart, exportar, gráfico, graph