Program Options for Detecting Repeated Words in Long Text: Highlighting Tools & More

         Dim Slowo As String           'slowo z tekstu - szukane
         Const max_ilo_slow = 9000              'ilosc maksymalna slow ... ograniczenia :(
         Dim Slowa(max_ilo_slow) As String      'tablica z slowami
         Dim Licznik_slowa(max_ilo_slow) As Integer      'tablica z iloscia wystapienia konkretnego slowa
         Dim Unikalne_licznik As Integer             'ilosc slow unikalnych w tekscie
         Dim Sortowanie As Boolean              'sortowanie - po ilosci wystapien
         Dim Ilosc_slow As Long                 'ilosc slow w dokumencie - wszystkie
         Dim Wylaczenia As String             'Slowa ktore wylaczyc z liczenia
         Dim F As Boolean               'flaga pomocnicza
         Dim j, k, l, Temp As Integer       'liczniki itp.
         Dim TmpSlowo As String                ' Tyczasowe slowo

         Wylaczenia = ""
         Wylaczenia = InputBox$("Wpisz słowa które chcesz wyłączyć z przesukiwanego tekstu, słowa umieść w nawiasach [ ].", " Wyłączone słowa", "")
'poniżej przykład jak wpisać:
'"[z][i][do][o][w]" itp
         ' pytanie czy sortować po ilości wystąpień
         Sortowanie = True

         Selection.HomeKey Unit:=wdStory
         System.Cursor = wdCursorWait
         Unikalne_licznik = 0
         Ilosc_slow = ActiveDocument.Words.Count
         WSlowa = ActiveDocument.Words.Count

         ' liczymy :)
         For Each aword In ActiveDocument.Words
             Slowo = Trim(aword)
             If Slowo < "A" Or Slowo > "z" Then Slowo = ""
             If InStr(Wylaczenia, "[" & Slowo & "]") Then Slowo = ""
             If Len(Slowo) > 0 Then
                 F = False
                 For j = 1 To Unikalne_licznik
                     If Slowa(j) = Slowo Then
                         Licznik_slowa(j) = Licznik_slowa(j) + 1
                         F = True
                         Exit For
                     End If
                 Next j
                 If Not F Then
                     Unikalne_licznik = Unikalne_licznik + 1
                     Slowa(Unikalne_licznik) = Slowo
                     Licznik_slowa(Unikalne_licznik) = 1
                 End If
                 If Unikalne_licznik > max_ilo_slow - 1 Then
                     j = MsgBox("W tekście jest więcej unikalnych słów niż podałeś. Zwiększ maksymalną ilość słów", vbOKOnly)
                     Exit For
                 End If
             End If
             Ilosc_slow = Ilosc_slow - 1
             StatusBar = "Pozostało: " & Ilosc_slow & "     Unikalnych: " & Unikalne_licznik
         Next aword

         ' sortowanie
         For j = 1 To Unikalne_licznik - 1
             k = j
             For l = j + 1 To Unikalne_licznik
                 If (Not Sortowanie And Slowa(l) < Slowa(k)) Or (Sortowanie And Licznik_slowa(l) > Licznik_slowa(k)) Then k = l
             Next l
             If k  j Then
                 TmpSlowo = Slowa(j)
                 Slowa(j) = Slowa(k)
                 Slowa(k) = TmpSlowo
                 Temp = Licznik_slowa(j)
                 Licznik_slowa(j) = Licznik_slowa(k)
                 Licznik_slowa(k) = Temp
             End If
             StatusBar = "Sortowanie: " & Unikalne_licznik - j
         Next j

         ' Wyniki w nowy dokument :) i jako tabelke :)
         tmpName = ActiveDocument.AttachedTemplate.FullName
         Documents.Add Template:=tmpName, NewTemplate:=False
         Selection.ParagraphFormat.TabStops.ClearAll
         With Selection
             For j = 1 To Unikalne_licznik
             .TypeText Text:=Slowa(j) & vbTab & Trim(Str(Licznik_slowa(j))) & vbCrLf
             Next j
         End With
         ActiveDocument.Range.Select
         Selection.ConvertToTable
         Selection.Collapse wdCollapseStart
         ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1)
         ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Słowo"
         ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Ilość wystąpień"
         ActiveDocument.Tables(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
         ActiveDocument.Tables(1).Rows.Add
         ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count, 1).Range.InsertBefore "Ilość wszystkich słów w dokumencie"
         ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count, 2).Range.InsertBefore WSlowa
         ActiveDocument.Tables(1).Rows.Add
         ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count, 1).Range.InsertBefore "Ilość unikalnych słów w dokumencie"
         ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count, 2).Range.InsertBefore Trim(Str(Unikalne_licznik))
         System.Cursor = wdCursorNormal
     Selection.HomeKey wdStory