How to find charts (graphs) in powerpoint using vba? - vba

I just want the code or property to find chart in the powerpoint silde using macro(vba).
thanks

One way to find chart is
Sub EachSlides()
'developer by Bruno Leite
'http://officevb.com
Dim sld As Slide
Dim i As Integer
For Each sld In ActivePresentation.Slides
For i = 1 To sld.Shapes.Placeholders.Count
'select the placeholder
sld.Shapes.Placeholders(i).Select msoCTrue
Next i
Next sld
End Sub

Related

Apply template on all PPT charts causes "User-defined type not defined" error

I am trying to apply a template on all charts in my PPT, but get an error stating
User-defined type not defined
I found the VBA online, and the person sharing it said it worked for him. Any suggestions? I thought it might be the dashes in the pathway, but using "-" or "_" does not help. Also tried removing the last parenthesis after the pathway.
Sub ChangeCharts()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.ApplyChartTemplate ( _
"Name\Users\Name\Library\Group Containers\UBF8T346G9.Office\User Content\Chart Templates\1.crtx")
Next myChart
End Sub
New VBA tried;
Sub ChangeCharts()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
Select Case oSh.Type
Case Is = 3 ' Chart created in PPT
Application.ActivePresentation.ApplyTemplate _
"name/Users/name/Library/Group Containers/UBF8T346G9.Office/User Content/Chart Templates/1.crtx"
End Select
Next ' oSh/Shape
Next ' oSl/Slide
End Sub
First, see the comments below to learn why your sample code can't work in PPT:
Sub ChangeCharts()
' PPT has no ChartObject type
Dim myChart As ChartObject
' PPT has no ActiveSheet object
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.ApplyChartTemplate ( _
"Name\Users\Name\Library\Group Containers\UBF8T346G9.Office\User Content\Chart Templates\1.crtx")
Next myChart
End Sub
Assuming you're running this from within PPT, you'll need something more like:
Sub ChangeCharts
Dim oSl as Slide
Dim oSh as Shape
For Each oSl in ActivePresentation.Slides
For Each oSh in oSl.Shapes
Select Case oSh.Type
Case Is = 3 ' Chart created in PPT
' apply the template here
With oSh.Chart
.ApplyChartTemplate "drive:\path\template_name.crtx"
End with ' the chart
' Other case statements as needed to
' cover embedded/linked OLE objects
' that are Excel charts
End Select
Next ' oSh/Shape
Next ' oSl/Slide
End Sub
ActiveSheet is an Excel object. I think you want to use ActiveSlide for PowerPoint.

Delete everything BUT charts in PPT presentation?

I want to delete everything in my powerpoint presentation, except the charts that are already there. I have been searching for day with no avail.
I did however find this VBA that deletes all charts. Unfortunately, it is the opposite of what I am trying to achieve. I have tried using VBA found in other code and adding it, but nothing helps. Any help would be much appreciated.
Sub RemoveAllCharts()
Dim sld As Slide
Dim i, num
'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
num = sld.Shapes.Count
For i = num To 1 Step -1
If sld.Shapes(i).HasChart Then
sld.Shapes(i).Delete
End If
Next i
Next sld
End Sub
You might be able to add a Not to achieve this, i.e. change
If sld.Shapes(i).HasChart Then
to
If Not sld.Shapes(i).HasChart Then
Sub RemoveAllButCharts()
Dim sld As Slide
Dim i As Long, num As Long
'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
num = sld.Shapes.Count
For i = num To 1 Step -1
If Not sld.Shapes(i).HasChart Then
sld.Shapes(i).Delete
End If
Next i
Next sld
End Sub

VBA for capitalizing title slides

I want to use VBA to capitalize each word in the titles of all my PowerPoint slides.
So far this is the code I am using:
Sub Capitalize()
Dim sld As Slide
For Each sld In ActivePresentation.Slides
sld.Title.TextFrame.TextRange.ChangeCase ppCaseTitle
Next sld
End Sub
It's giving me an error by highlighting the "Title" and saying "Method or data member not found"
Any help would be greatly appreciated. Thanks!
The Title object is available on the Shapes object, which maps on to the placeholder title for the slide. I would also use the HasTitle property to check if the slide has a title or not.
Sub Capitalize()
Dim sld As Slide
For Each sld In ActivePresentation.Slides
If sld.Shapes.HasTitle Then
sld.Shapes.Title.TextFrame.TextRange.ChangeCase ppCaseTitle
End If
Next sld
End Sub
A Slide object doesn't have a Title property. You need to look for the Shape object that contains the title text.
Iterate the .Shapes collection and use its Name to know when you've found the one that contains your title (then you can exit the loop).
This assumes you've named the title shape "Title" or something.
Dim sld As Slide, shp As Shape
Dim found As Boolean
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Name = "Title" Then
found = True
shp.TextFrame.TextRange.ChangeCase ppCaseTitle
End If
If found Then Exit For
Next
If found Then Exit For
Next

PowerPoint VBA - loop all slides, all shapes, find chart, set datalabel color to Black

I'm new to PowerPoint VBA so please bear with me.
I would like to:
loop through all the slides on a given pptx,
loop through all the shapes on a given slide,
find chart shapes
loop through the chart's series collection
set the datalabel color property to dark black.
So far I have been able to complete the first 3 tasks but I need help with the last 2. Here is my code:
Sub test()
Dim slide As Object
Dim shape As Object
Dim shapeNames As Object
Dim chSeries As Series
i = 0
For Each slide In ActivePresentation.Slides
For Each shape In slide.Shapes
If shape.HasChart Then
i = i + 1
Debug.Print "found a chart on slide", i
End If
Next
Next
End Sub
Solved.
Sub test()
Dim sld As Slide
Dim shp As Shape
Dim sr As Series
Dim chrt As Chart
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Debug.Print shp.Chart.ChartType
If shp.Chart.ChartType = 57 Then
shp.Chart.SeriesCollection(1).DataLabels.Font.Color = RGB(0, 0, 0)
End If
End If
Next shp
Next sld
End Sub
Though I didn't successfully loop over the series in chart but this works.

Perform one action for multiple sheets

I wrote the following code with lets me put a text into the first shape of my first sheet
Sub OpenFiles()
With ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange
.Text = "test"
End With
End Sub
I however want to apply this to all the first shapes of the sheets in my presentation. Does anybody know how I have to enhance my code for this.
Dear regards,
Marc
Sub OpenFiles()
Dim oSl as Slide
For Each oSl in ActivePresentation.Slides
oSl.Shapes(1).TextFrame.TextRange.Text = "test"
Next
End Sub
Sub OpenFiles()
Dim oSl as Slide
For Each oSl in ActivePresentation.Slides
oSl.Shapes(1).TextFrame.TextRange.Text = "test"
End With
End Sub
Now see KazJaw's first comment and try it out.