Search code examples
vbapowerpointms-office

Find and Replace User Specified String in Powerpoint VBA

Good Day,

I've just started doing macros in Powerpoint VBA with absolutely no programming knowledge(this is true), what i'm trying to do is Find and then Replace a user specified string with a Case Sensitive option, but unfortunately my dumbass Brain can't keep up with all the Codes i've written myself, well... most of them came from Google anyway, but honestly, i seriously don't know what im doing anymore.

Here is my Code so far:

Sub FindReplaceVBA()
    Dim xFind       As String: xFind = ""
    Dim xReplace    As String: xReplace = ""
    Dim sld         As Slide
    Dim shp         As Shape
    Dim xCase       As Boolean: xCase = False
    Dim xCaseStr
    Dim xRng As TextRange

    xCaseStr = MsgBox("Search with Case Sensitive?", vbYesNoCancel, "FindReplace")
    If xCaseStr = vbCancel Then
       MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
       Exit Sub
       ElseIf xCaseStr = vbYes Then
        xCase = True
        GoTo FindHere
       Else:
        GoTo FindHere
    End If

FindHere:
     xFind = InputBox("What To find..." & vbNewLine & "Case Sensitive is " & xCase, "FindReplace")
    If StrPtr(xFind) = 0 Then
        MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
        Exit Sub
    ElseIf xFind = vbNullString Then
        MsgBox "You cannot leave it Blank!", vbExclamation + vbOKOnly
        GoTo FindHere
    Else:
        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                If shp.TextFrame.HasText Then
                    Set xRng = shp.TextFrame.TextRange
                    xFind = xRng.Find(FindWhat:=xFind, MatchCase:=xCase)
                    If Not (xFind Is Nothing) Then 'Find first before specifying what to replace'
                        GoTo ReplaceHere
                        Else:
                        MsgBox "Keywords not Found.", vbCritical + vbOKOnly
                        Exit Sub
                    End If
                End If
            Next shp
        Next sld
    End If

ReplaceHere:
     xReplace = InputBox("Replace " & Chr(34) & xFind & Chr(34) & " With..." & vbNewLine & "Case Sensitive is " & xCase, "FindReplace")
    If StrPtr(xReplace) = 0 Then
        MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
        Exit Sub
    ElseIf xReplace = vbNullString Then
        MsgBox "You gotta Type something To replace it...", vbExclamation + vbOKOnly
        GoTo ReplaceHere
    Else:
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    If xCase = True Then
                        shp.TextFrame.TextRange.Text = shp.TextFrame.TextRange.Replace(FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=True)
                       Else:
                        shp.TextFrame.TextRange.Text = shp.TextFrame.TextRange.Replace(FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=False)
                    End If
                End If
            End If
        Next shp
     End If
End Sub

Also, is it also possible to do the Operation within selected Slides only? Any help is Absolutely~ Appreciated.

Solution

  • Your code almost works as it is, there are just two slight adjustments necessary:

    1. Firstly, xRng.Find(FindWhat:=xFind, MatchCase:=xCase) returns a TextRange Object, so you can't set xFind (a string) equal to it and you can't check if a string is nothing. Therefore I added another variant xFindRng to your code to perform this "test find".

    2. And second, instead of shp.TextFrame.TextRange.Text = shp.TextFrame.TextRange.Replace(FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=True) you should just use shp.TextFrame.TextRange.Replace FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=True

    This is the debugged code:

    Sub FindReplaceVBA()
    Dim xFind       As String: xFind = ""
    Dim xFindRng
    Dim xReplace    As String: xReplace = ""
    Dim sld         As Slide
    Dim shp         As Shape
    Dim xCase       As Boolean: xCase = False
    Dim xCaseStr
    Dim xRng As TextRange

    xCaseStr = MsgBox("Search with Case Sensitive?", vbYesNoCancel, "FindReplace")
    If xCaseStr = vbCancel Then
       MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
       Exit Sub
       ElseIf xCaseStr = vbYes Then
        xCase = True
        GoTo FindHere
       Else:
        GoTo FindHere
    End If

FindHere:
     xFind = InputBox("What To find..." & vbNewLine & "Case Sensitive is " & xCase, "FindReplace")
    If StrPtr(xFind) = 0 Then
        MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
        Exit Sub
    ElseIf xFind = vbNullString Then
        MsgBox "You cannot leave it Blank!", vbExclamation + vbOKOnly
        GoTo FindHere
    Else:
        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                If shp.TextFrame.HasText Then
                    Set xRng = shp.TextFrame.TextRange
                    Set xFindRng = xRng.Find(FindWhat:=xFind, MatchCase:=xCase)
                    If Not (xFindRng Is Nothing) Then 'Find first before specifying what to replace'
                        GoTo ReplaceHere
                        Else:
                        MsgBox "Keywords not Found.", vbCritical + vbOKOnly
                        Exit Sub
                    End If
                End If
            Next shp
        Next sld
    End If

ReplaceHere:
     xReplace = InputBox("Replace " & Chr(34) & xFind & Chr(34) & " With..." & vbNewLine & "Case Sensitive is " & xCase, "FindReplace")
    If StrPtr(xReplace) = 0 Then
        MsgBox "User Cancelled!", vbCritical + vbOKOnly, "FindReplace"
        Exit Sub
    ElseIf xReplace = vbNullString Then
        MsgBox "You gotta Type something To replace it...", vbExclamation + vbOKOnly
        GoTo ReplaceHere
    Else:
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    If xCase = True Then
                        shp.TextFrame.TextRange.Replace FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=True
                       Else:
                        shp.TextFrame.TextRange.Replace FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=False
                    End If
                End If
            End If
        Next shp
     End If
End Sub

    Of course it is possible to include only some of the slides for the replacement, there are many ways to achieve this and it depends on how you want to specify which slides to include. For instance, you could select the slide numbers, just use the currently selected slides, etc...

    As a side note, I don't really understand why you wouldn't allow replacement with an empty string:

        ElseIf xReplace = vbNullString Then
        MsgBox "You gotta Type something To replace it...", vbExclamation + vbOKOnly

    Replacing something with nothing is very useful in my opinion and often makes sense. But then again I don't know what you will be using this for...