VBA to conditionally edit slide titles?

[ajjava]

I'd like to be able to run a script that will:

1. Loop through all slides
2. Look at the title placeholder (which is NOT always the first object on the slide, which I've learned may be problematic, code-wise) and determine the existence of 6 "target" words
3. If any of those target words are found, delete the words, or find/replace (find word, replace with a space)

I have pieces of a find/replace script, and I have pieces of a "edit title" script - but I'm struggling to integrate the two into a working solution.

Target words: Total, What, Where, Who, TTD
Example title, before/after: 'NEW WHERE' becomes 'NEW'

[John Wilson]

You could probably work around this:


Sub fix_Title()
Dim osld As Slide
Dim rayText() As String
Dim titleText As String
Dim L As Long
rayText = Split("Total,Who,What,Where,TTD", ",")
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
For L = 0 To 4
titleText = osld.Shapes.Title.TextFrame.TextRange.Text
If InStr(titleText, rayText(L)) > 0 Then
' Put replace code here
End If
Next L
End If
Next
End Sub

[ajjava]

Thanks very much, John. Can you tell me what the L represents, in this scenario? Also, what's the correct syntax for the "replace" code, if I want to leave the title intact, minus the "target" word?


Oh, I think I understand - the L represents the number of target words, if you count 0 as 1. Is that right?

[John Wilson]

Yes

Arrays start by default at zero so it's 0,1,2,3,4

[ajjava]

And would you mind addressing the "replace" code part? I'm struggling with the syntax that will "leave all intact, but delete the target word".

[John Wilson]

I think I would delete word rather than replace.

Something like this


Sub fix_Title()
Dim osld As Slide
Dim rayText() As String
Dim titleText As TextRange
Dim L As Long
rayText = Split("Total,Who,What,Where,TTD", ",")
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
For L = 0 To 4
Set titleText = osld.Shapes.Title.TextFrame.TextRange
If InStr(UCase(titleText), UCase(rayText(L))) > 0 Then
Set titleText = Deleter(titleText, rayText(L))
End If
Next L
End If
Next
End Sub


Function Deleter(otr As TextRange, strword As String) As TextRange
Dim L As Long
For L = otr.Words.Count To 1 Step -1
If Trim(UCase(otr.Words(L))) = UCase(strword) Then otr.Words(L).Delete
Next L
End Function

[ajjava]

This is absolutely PERFECT. Thank you very much for the help you provide on a regular basis. It really is invaluable.
If you're so inclined, I'd love to see an explanation of the Function part of your solution. I want to grow to be self-sufficient(ish) in VBA :)