Views

Histats

Vitrine

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



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.ApplicationDim oPPTShape As PowerPoint.ShapeDim oPPTFile As PowerPoint.Presentation
Public oGraph As Graph.ChartDim 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).ValueoGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value
oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).ValueoGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value
oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).ValueoGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value
oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).ValueoGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value
oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).ValueoGraph.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
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


Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


Tags: VBA, excel, chart, powerpoint,


✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias