Sub SlovCoord()
Dim OL, tb As MSForms.TextBox, tbName$
Dim shp As Shape
Dim X&, Y&, X0&, Y0&
Dim fontName$, fontSize&, fontItalic As Boolean, fontBold As Boolean
Dim r As Range, slovo$
Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y
Application.ScreenUpdating = False
    Set r = Cells(18, 5) 'r = Selection 'из выделенной ячейки
        X0 = r.Left - 12 'textbox делает небольшой отступ слева для текста
        Y0 = r.Top
    With r.Font
        fontName = .Name
        fontSize = .Size
        fontBold = .Bold
        fontItalic = .Italic
    End With
    Set rX = Cells(23, 5)
    Set rY = Cells(24, 5)
    tbName = "textbName"
    slovo = InputBox("Введите слово, координату которого ищете", _
    "Слово", "семь")
    Cells(1, 1).Select 'Почему-то на размер ТекстБокса влияет выделенная ячейка, поэтому закрепляем
    Set OL = ActiveSheet.OLEObjects.Add("Forms.TextBox.1")
    r.Select
    OL.Name = tbName
    Set tb = OL.Object
    Set shp = ActiveSheet.Shapes(tbName)
    shp.Placement = xlFreeFloating
'    tb.Value = "1"
    shp.Height = r.Height
'    shp.Left = X0
'    shp.Top = Y0
    tb.AutoSize = True
    tb.WordWrap = False
    tb.Font.Size = fontSize
    tb.Font.Italic = fontItalic
    tb.Font.Bold = fontBold
    tb.Font.Name = fontName
    tb.Activate
    tb.Value = Left(r.Value, 1 + InStr(1, r.Value, " " & slovo))
    shp.Left = X0
    shp.Top = Y0
'    tb.SpecialEffect = 1
    X = X0 + shp.Width
    Y = Y0 + shp.Height / 2
    shp.Delete
    Set tb = Nothing
    Set shp = Nothing
    rX = X
    rY = Y
Application.ScreenUpdating = True
End Sub