I'm trying to write a macro in PowerPoint that, for each picture, iterates over each pixel so as to get the current color of each pixel and then be able to change the color. I have found some references about how to do this in VBA, but they refer to Excel, so many functions are not applicable in my case in PowerPoint.
I am not quite familiar with PowerPoint VBA, but my approach was:
Sub ChangeColor()
Dim oshp As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Name Like "Picture*" Then
'FUNCTION TO ITERATE OVER PIXELS AND CHANGE COLOR OF EACH PIXEL
End If
Next oshp
Next osld
End Sub
However, I don't know how to iterate over pixels. Can somebody help me to understand how can I do this?
Many thanks in advance!
Related
I'm trying to run through a huge PowerPoint file and I want to change certain TextBoxes fonts on each slide (not every slide has the textbox) however I keep getting an error when it can't be found on a slide (which is fine I just want it to skip to the next slide and check and change if necessary) How would I fix this please?
Sub ChangeIndividualFonts()
Dim bpFontName As String
bpFontName = "Arial"
With ActivePresentation
For Each Slide In .Slides
For Each Shape In Slide.Shapes
With Slide.Shapes("TextBox 5")
If .HasTextFrame Then
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Name = bpFontName
End If
End If
End With
Next
Next
End With
End Sub
Goal:
-Loop through presentation checking each slide for a certain title
-Once title is found
-Copy the shapes for the charts and footnote
-Then paste them into a separate presentation.
Notes:
-The slides in the presentations don't have titles but are located at Shapes(1)
-I receive a
run-time error '-2147024809 (80070057)': The specified value is out of
range.
-This error occurs on the line of the If statement
Sub library_update()
Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")
Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")
Dim sld as slide
For Each sld In NTppt.Slides
If sld.Shapes(1).TextFrame.TextRange.Text = "Fixed Income - Yield Curves" Then
With NTppt
sld.Shapes.Range(Array(2, 3)).Copy
ppt.Slides(1).Shapes.Paste
End With
End If
Next sld
End Sub
The solution below worked. I am not sure why my code produced the original run time error but I assume it has something to do with not finding shapes(1) in some of my powerpoint slides.
To fix the problem, I searched for "Fixed Income - Yield Curves" in all shapes of all slides.
Sub library_update()
Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")
Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")
Dim sld As Slide
Dim shp As Shape
For Each sld In NTppt.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txt_range = shp.TextFrame.TextRange
'Confirm exact spelling and capitalization of the slides or an error will return
If txt_range = "Fixed Income – Yield Curves" Then
With NTppt
sld.Shapes.Range(Array(2, 3)).Copy
ppt.Slides(2).Shapes.Paste
End With
End If
End If
Next shp
Next sld
End Sub
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
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.
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