Replace shape(autoshape) not working when contains text in PowerPoint vba - vba

Question

Need little help from this forum.
I want to replace shape(autoshape) with other autoshape in my project & found a solution here http://www.vbaexpress.com/forum/showthread.php?68760-Change-Fill-color-using-VBA-in-PowerPoint.
But in my project there are some shapes which contains text(I did not use textbox).
The code are select shape(which will be replaced) by some critaria
ie
by height 2. by weidth 3. fill colour 4. by top position.
As textbox is not a autoshape thats why I used shape which contains text & to give text backgroung transparent I used 'shape fill' to 'no fill'.
In my project there are shapes(not contains text) which are same size & same top position(ie the shape just behind the text shape).
Code is working fine for those shape which did not contains text.When I select the text shape & run the code it replaced all the shape behind the text shape ie
not replace the text shape(which I want to replace).
I tried a lot but not getting the solution.I also tried with changeing the weidth of the shape behind the textshape but not get desire result.
Sir any solution will be highly appreaciate.
Option Explicit
Dim oShapeAfterChange As Shape, oShapeToChange As Shape
Dim tShapeAfterChange As MsoAutoShapeType, tShapeToChange As MsoAutoShapeType
Dim iShapeAfterChangeRGB As Long, iShapeAfterChangeHeight As Double, iShapeAfterChangeWidth As Double, iShapeAfterChangeTop As Double
Sub Step1()
If MsgBox("This is Step 1 of a two step process" & vbCrLf & vbCrLf & _
"1. You must already have inserted and selected a new Shape to change to" & vbCrLf & _
"2. After running, Step1 will remember the new type of shape" & vbCrLf & _
"3. Select one of the shapes to be changed" & vbCrLf & _
"4. Run the Step2 Macro", vbOKCancel + vbInformation, "Change Shapes") = vbCancel Then
Exit Sub
End If
Set oShapeAfterChange = Nothing
On Error Resume Next
Set oShapeAfterChange = ActiveWindow.Selection.ShapeRange(1)
oShapeAfterChange.PickUp
tShapeAfterChange = oShapeAfterChange.AutoShapeType
On Error GoTo 0
If oShapeAfterChange Is Nothing Then
Call MsgBox("You must select an AutoShape", vbCritical + vbOKOnly, "Change Shapes")
Exit Sub
End If
Call MsgBox("Destination Shape type memorized", vbOK + vbInformation, "Change Shapes")
End Sub
Sub Step2()
Dim oPres As Presentation
Dim oSlide As Slide
Dim oShape As Shape, oShapeInGroup As Shape
If MsgBox("This is Step 2 of a two step process" & vbCrLf & vbCrLf & _
"1. You must already have selected an instance of a Shape to change" & vbCrLf & _
"2. All instances on all slides of that type of Shape will be changed", vbOKCancel + vbInformation, "Change Shapes") = vbCancel Then
Exit Sub
End If
If oShapeAfterChange Is Nothing Then
Call MsgBox("1. You must select an example of a new Shape to change the shapes to" & vbCrLf & _
"2. Re-run Step1", vbCritical + vbOKOnly, "Change Shapes")
Exit Sub
End If
Set oShapeToChange = Nothing
Set oShapeToChange = ActiveWindow.Selection.ShapeRange(1)
If oShapeToChange.Type = msoGroup Then
If ActiveWindow.Selection.HasChildShapeRange Then
If ActiveWindow.Selection.ChildShapeRange.Count <> 1 Then
Call MsgBox("You must select exactly one Shape within the Group of the type to be changed", vbCritical + vbOKOnly, "Change Shapes")
Exit Sub
Else
Set oShapeToChange = ActiveWindow.Selection.ChildShapeRange(1)
End If
End If
End If
If oShapeToChange Is Nothing Then
Call MsgBox("You must select a Shape of the type to be changed", vbCritical + vbOKOnly, "Change Shapes")
Exit Sub
End If
With oShapeToChange
tShapeToChange = .AutoShapeType
iShapeAfterChangeRGB = .Fill.ForeColor.RGB
iShapeAfterChangeHeight = Round(.Height, 0)
iShapeAfterChangeWidth = Round(.Width, 0)
iShapeAfterChangeTop = Round(.Top, 0)
End With
Set oPres = ActivePresentation
For Each oSlide In oPres.Slides
For Each oShape In oSlide.Shapes
If oShape.Type = msoGroup Then
For Each oShapeInGroup In oShape.GroupItems
Call pvtChangeAutoShapeType(oShapeInGroup)
Next
Else
Call pvtChangeAutoShapeType(oShape)
End If
Next
Next
oShapeAfterChange.Delete
MsgBox "Shapes updated successfully"
End Sub
Private Sub pvtChangeAutoShapeType(o As Shape)
Dim CenterTop As Double, CenterLeft As Double
With o
If .Type <> msoAutoShape Then Exit Sub
If .AutoShapeType <> tShapeToChange Then Exit Sub
If .Fill.ForeColor.RGB <> iShapeAfterChangeRGB Then Exit Sub
If Round(.Height, 0) <> iShapeAfterChangeHeight Then Exit Sub
If Round(.Width, 0) <> iShapeAfterChangeWidth Then Exit Sub
If Round(.Top, 0) <> iShapeAfterChangeTop Then Exit Sub
.AutoShapeType = tShapeAfterChange
CenterTop = .Top + .Height / 2#
CenterLeft = .Left + .Width / 2#
.Height = oShapeAfterChange.Height
.Width = oShapeAfterChange.Width
.Left = CenterLeft - oShapeAfterChange.Width / 2#
.Top = CenterTop - oShapeAfterChange.Height / 2#
.Apply
End With
End Sub