Private Counter
Function FindText()
    Set TR = Document.Body.CreateTextRange
    What = Query.Value
    Counter = 0
    If What = "" Then
        Msgbox "Musíte zadat název hledané položky !"
    Else
        Window.status = "Probíhá vyhledávání, čekejte prosím ..."
        Do While TR.FindText(What)
            Counter = Counter + 1
            TR.PasteHtml "<SPAN CLASS=selected>" & TR.Text & "</SPAN>"
        Loop
        Window.status = ""
        If Counter = 0 Then
            MsgBox "Slovo '" & What & "' nebylo nalezeno", vbInformation, "Výsledek hledání"
        Else
            MsgBox "Nalezeno " & Counter & " výskytů slova " & What, vbInformation, "Výsledek hledání"
        End If
        Set TR = Nothing
    End If
End Function