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.
CodePudding user response:
Your code almost works as it is, there are just two slight adjustments necessary:
Firstly,
xRng.Find(FindWhat:=xFind, MatchCase:=xCase)
returns aTextRange
Object, so you can't setxFind
(a string) equal to it and you can't check if a stringis nothing
. Therefore I added another variantxFindRng
to your code to perform this "test find".And second, instead of
shp.TextFrame.TextRange.Text = shp.TextFrame.TextRange.Replace(FindWhat:=xFind, ReplaceWhat:=xReplace, MatchCase:=True)
you should just useshp.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...