Find and Replace Macro

Question

Hi,

I am using PPT 2007. I need to create a VBA macro which functions exactly as the "Find and Replace" option (Ctrl+h).

Backgroud: we need to find considerable amount of text in the ppt files that we create and replace it with the standard text. Checklist sort of.

As of now we have to manually find and replace the text using built-in PPT option. If I can get a macro that will find and replace the text as required, it will be great.

I found many macros that does this however, these are not exavtly the same as Find and Replace option. PPT option takes the user to the slide where it is replacing the text and we can choose whether to replace or not. However the macros that I found just replace the text and we never know what all things have been replaced.

Any help will be much appreciated...!

Answer 1

Hi,

I took this code from some other link, sorry I do not remember, I merged that code with the one provided to me earlier by John SR Wilson

the code in the link works fine but it does not prvide the msg box which asks whether to replace or no..... I am not from a programming background hence any code that I use is taken from the internet...

Answer 2

I modified the code so that I am able to search grouped shapes and tables and MS Objects... The code is as follows:

Problem: It selects any text which is there in the shapes adn replaces it with the 'ReplaceWith'...

It Finds any text present in the table and replaces it with nothing

It doesnt take me to the current slide where it is making changes...

HELP PLEASE ...

-----------Macro-----------------

Sub Global_1()

    Dim oPres As Presentation

    Dim oSld As Slide

    Dim oShp As Shape

    Dim FindWhat As String

    Dim ReplaceWith  As String

    FindWhat = "This"

    ReplaceWith = "That"

    For Each oPres In Application.Presentations

       For Each oSld In ActivePresentation.Slides

                    For Each oShp In oSld.Shapes

                    Call FindnRe(oShp, FindWhat, ReplaceWith)

            Next oShp

        Next oSld

    Next oPres

End Sub

-----------For Reference-----------------

Sub FindnRe(oShp As Object, FindString As String, ReplaceString As String)

    Dim oTxtRng As TextRange

    Dim oTmpRng As TextRange

    Dim I As Integer

    Dim iRows As Integer

    Dim iCols As Integer

    Dim oShpTmp As Shape

    On Error Resume Next

    Select Case oShp.Type

Case 19    'msoTable

    For iRows = 1 To oShp.Table.Rows.Count

        For iCol = 1 To oShp.Table.Rows(iRows).Cells.Count

            Set oTxtRng = oShp.Table.Rows(iRows).Cells(iCol).Shape.TextFrame.TextRange

            Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _

                                          Replacewhat:=ReplaceString, WholeWords:=True)

            Do While Not oTmpRng Is Nothing

            oTmpRng.Select

            If MsgBox("Replace?", vbYesNo) = vbYes Then oTmpRng.Text = strReplaceWith

            Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _

                                              Replacewhat:=ReplaceString, _

                                              After:=oTmpRng.Start + oTmpRng.Length, _

                                              WholeWords:=True)

            Loop

        Next

    Next

Case msoGroup    'Groups may contain shapes with text, so look within it

    For I = 1 To oShp.GroupItems.Count

        Call FindnRe(oShp.GroupItems(I), FindString, ReplaceString)

    Next I

Case 21    ' msoDiagram

    For I = 1 To oShp.Diagram.Nodes.Count

        Call FindnRe(oShp.Diagram.Nodes(I).TextShape, FindString, ReplaceString)

    Next I

Case Else

    If oShp.HasTextFrame Then

        If oShp.TextFrame.HasText Then

            Set oTxtRng = oShp.TextFrame.TextRange

            oTxtRng.Select

            If MsgBox("Replace?", vbYesNo) = vbYes Then oTmpRng.Text = strReplaceWith

                        Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _

                                          Replacewhat:=ReplaceString, WholeWords:=True)

            Do While Not oTmpRng Is Nothing

                Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _

                                              Replacewhat:=ReplaceString, _

                                              After:=oTmpRng.Start + oTmpRng.Length, _

                                              WholeWords:=True)

            Loop

        End If

    End If

    End Select

End Sub

Answer 3

I thought it DID select the text to be replaced?

otxtTemp.Select works here to do that in 2007

However I have noticed in code we are developing to do pattern (Regex) search replaces in PPT this sometimes does not select first time. Maybe the superExperts (ie Steve & Shyam etc) know why??

Answer 4

This is 99.99% of what I was looking for...

The 0.01%: Is there any way wherein the macro selects the text which it is about to replace...

This code will help me a lot ... Thanks a million for your help..

The world will always need Experts to give the final touch... Otherwise rookies like me will keep on searching the internet... and find nothing !

Answer 5

Maybe something based on:

Sub FindAndReplace()

    Dim oSld As Slide

    Dim oShp As Shape

    Dim otxtTemp As TextRange

    Dim otxtR As TextRange

    Dim strFindWhat As String

    Dim strReplaceWith  As String

    strFindWhat = "This"

    strReplaceWith = "That"

    For Each oSld In ActivePresentation.Slides

    ActiveWindow.View.GotoSlide oSld.SlideIndex

    For Each oShp In oSld.Shapes

    If oShp.HasTextFrame Then

    If oShp.TextFrame.HasText Then

    Set otxtR = oShp.TextFrame.TextRange

    Set otxtTemp = oShp.TextFrame.TextRange.Find(strFindWhat, 0, False, True)

    Do While Not otxtTemp Is Nothing

    otxtTemp.Select

    If MsgBox("Replace?", vbYesNo) = vbYes Then otxtTemp.Text = strReplaceWith

    Set otxtTemp = otxtR.Find(strFindWhat, otxtTemp.Start + otxtTemp.Length, False, True)

    Loop

    End If

    End If

    Next oShp

    Next oSld

End Sub