I am writing Find/Replace in VBA Excel. I have picked this code from google. When I run this code by pasting on PPT as a Macro, it runs fine but it is not running on Excel(When I Paste this code on Excel as MAcro) VBA for PPT. Actually I have an application which is made on VBA Excel. I open a PPT file through my application on which find and replace action is performed.
Dim FindWhat As String
Dim ReplaceWith As String
Dim oShp As PowerPoint.Shape
Dim oRng As TextRange
Dim oPres As Presentation
Dim oSld As Slide
Dim pptSlide As PowerPoint.Slide
public sub ReplaceInPPT()
FindWhat = searchtext
ReplaceWith = valuetext
For Each oPres In Application.Presentations '<- Throws "Object doesn't support this property or method"
For Each pptSlide In oPres.Slides
On Error Resume Next
For Each oShp In oSld.Shapes
Call ReplaceTextPPT(oShp, FindWhat, ReplaceWith)
Next oShp
Next pptSlide
Next oPres
End Sub
Public Sub ReplaceTextPPT(oShp As Object, FindString As String, ReplaceString As String)
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
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 ReplaceText(oShp.GroupItems(i), FindString, ReplaceString)
Next i
Case 21 ' msoDiagram
For i = 1 To oShp.Diagram.Nodes.count
Call ReplaceText(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
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 - 1) + oTmpRng.Length, WholeWords:=True)
Loop
End If
End If
End Select
End Sub