Макрос для підрахунку ключових слів

Доброго дня!

Макрос для підрахунку ключових слів в MS Word (vba)

Наприклад, дано текст, я якому має міститися:

 - трикотаж – 2 раза

- Київ– 1 раз і т.д

частина коду, для пошуку ключових слів є:

Option Compare Text

Function CountText(ByVal t As String) As Long

    Dim Count As Long

    With ActiveDocument.Range.Find

        .Text = t

        Do While .Execute = True

            Count = Count + 1

        Loop

    End With

    CountText = Count

End Function

Sub test1()

Dim Texts

Texts = Array("Дитячі шапочки", "Дитячі шапочки оптом", "Дитячі шапочки недорого", "шапочки для дітей", "трикотаж ", _

            "Україна", "Київ", "Недорого", "Дешево", "Від виробника", "Оптом", "Опт ", "Опт.", "в роздріб")

Dim Message As String

For Each Text In Texts

    Message = Message & Text & " - " & CountText(Text) & vbNewLine

Next

MsgBox (Message)

End Sub

Потрібно доробити:

1. Ключові слова вводити через діалогове вікно, з окремого файлу

2. Результат показувати як:

трикотаж - 1/2,

де - 1 - скільки в тексті знайдено,

2 - скільки має бути,

якщо не співпадає, 1!=2, виділити червоним кольором

3. знайдені ключові слова виділяти жовтим кольором

4. Результат виконання зберегти в файлі  .doc, в якому виконувався макрос

5. Знаходити і видаляти пробіли >=2