WordVBA, Insert and Pos. Shape with selection.find

Public Sub test()
Dim strPathPic As String
Dim strPic As String
Dim strBMP As String
Dim Shp As Shape
Dim dblLeft As Double
Dim dblTop As Double
Dim blnYesNo As Boolean
strPathPic = "C:\FHK95\Bilder\"
strBMP = ".bmp"
If MsgBox("Angebot mit Bildern Ja, oder nein?", vbYesNo) _
= vbYes Then blnYesNo = True Else blnYesNo = False
For iCounter = 1 To 15
If iCounter = 1 Then strPic = "Shape_Streifenfundament"
strPAR = strPathPic & strPic & strBMP
Do
If blnYesNo = True Then
Set Shp = ActiveDocument.Shapes.AddPicture(FileName:= _
strPAR, LinkToFile:=False, savewithdocument:=True)
With Shp
.ConvertToInlineShape
.Width = 125
.Height = 50
.Select
End With
Selection.Cut
End If
With Word.Selection.Find
.ClearFormatting
.Text = strPic
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
If blnYesNo = False Then
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
ElseIf blnYesNo = True Then
If .Execute = True Then
Selection.Paste
dblLeft = Shp.Left
dblTop = Shp.Top
'                            Shp.Delete
'                            Selection.Paste
Shp.WrapFormat.Type = wdWrapThrough
Shp.Left = dblLeft + 365
Shp.Top = dblTop + 45
Else: Exit Do
End If
End If
End With
Loop
Next iCounter
End Sub