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

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

1. 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