Find and replace underlined words for a blank.

[Closed]
Report
Posts
1
Registration date
Thursday December 20, 2012
Status
Member
Last seen
December 20, 2012
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,
This is my very first forum joined. I am on a quest to find the if there is a way to search and replace underlined words and replace them with just an underline in Powerpoint 2010. For example:

A true friend sticks with you thru good and bad times. Find the underlined words.

Replace with.

A true ____ sticks with you thru good and ____ times.

I am an administrative assistant to the senior pastor and this is a twice a week procedure. I would like to see if there is a way I can handle this task more efficiently.

Thank you very much for any help.




2 replies

Posts
47368
Registration date
Monday February 1, 2010
Status
Moderator
Last seen
September 1, 2021
11,000
Greetings,

Sorry but Power Point does not have a text editor.

You could however copy the slide with just the underline and make a new slide with for instance, just the first word and so on.

In your presentation, you would see this

Slide one:

Find the missing words

A true ____ sticks with you thru good and ____ times.

Slide two

A true friend sticks with you thru good and ____ times.

Slide three

A true friend sticks with you thru good and bad times.

There are all kinds of effects you can add.

Good luck and God bless.

P.S. What is the pastor pastoring ? (What church ?)
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Try this.

Option Explicit 

Sub replaceUnderLineWithSpace() 

Dim sld         As Slide 
Dim sh          As Shape 
Dim startPos    As Long 
Dim shapeText   As String 

    For Each sld In ActivePresentation.Slides 

        For Each sh In sld.Shapes 
            If sh.HasTextFrame Then 
                If sh.TextFrame.HasText Then 
                    startPos = 1 
                    shapeText = sh.TextFrame.TextRange.Text 
                    Do 
                        With sh.TextFrame.TextRange.Characters(Start:=startPos, Length:=1) 
                            If (.Font.Underline = msoTrue) Then 
                                .Text = " " 
                            End If 
                        End With 
                        startPos = 1 + startPos 
                    Loop While (startPos < Len(shapeText)) 
                End If 
            End If 
        Next 

    Next 
End Sub