Private Sub Check()
  Dim StartPos As Long
  Dim arrWords() As String, Text As String
  Dim WrongWord As String
  Dim SearchWrong As Long
  Dim RetValChange As Long, RetValIgnore As Long
 
  StartPos = 1
 
  Text = Replace(Original.Text, vbCrLf, " ")
  Text = Replace(Text, vbLf, " ")
  Text = Replace(Text, vbCr, " ")
  arrWords = Split(Text, " ")
 
  With ProgBar
    .Min = 0
    .Max = UBound(arrWords) + 1
  End With
 
  ' Sicherstellen, dass das Wort im RTF-Text
  ' hervorgehoben wird
  Original.HideSelection = False
 
  cmdAbort.Tag = ""
  For SearchWrong = 0 To UBound(arrWords)
    If arrWords(SearchWrong) <> "" And SpellCheck(arrWords(SearchWrong)) = _
      False Then
 
      WrongWord = GetTrueWord(arrWords(SearchWrong))
 
      StartPos = InStr(StartPos, Original.Text, WrongWord)
 
      With Original
        .SelStart = StartPos - 1
        .SelLength = Len(WrongWord)
      End With
 
      ' Startposition für Suche nach nächstem falschen Wort setzen
      StartPos = StartPos + Len(WrongWord)
 
      RetValChange = GetAlways(WrongWord)
      If RetValChange = -1 Then RetValIgnore = GetIgnore(WrongWord)
 
      If RetValChange > -1 Then
        ' wenn "Alle ändern"
        Original.SelRTF = arrAlwaysChange(1, RetValChange)
        txtNewWord.Tag = "weiter"
      ElseIf RetValIgnore > -1 Then
        ' nichts tun, außer:
        txtNewWord.Tag = "weiter"
      Else
        ' Felder zurücksetzen
        txtWrongWord.Text = ""
        lstSuggestions.Clear
        txtNewWord.Text = ""
 
        ' sonst Verbesserungsvorschläge holen
        Call GetSuggestions(WrongWord)
      End If
 
      Do
        DoEvents
      Loop Until txtNewWord.Tag = "weiter" Or cmdAbort.Tag = "stop"
    End If
    If cmdAbort.Tag = "stop" Then Exit For
 
    ' Textbox für nächste Suche zurücksetzen
    txtNewWord.Tag = ""
 
    ProgBar.Value = SearchWrong + 1
 
    lblProgress.Caption = _
      Format(ProgBar.Value / ProgBar.Max * 100, "##") & " %"
    DoEvents
  Next SearchWrong
  cmdReady.Enabled = True
 
  If cmdAbort.Tag = "stop" Then cmdReady.Value = True
End Sub

Private Sub Form_Load()
  ' Word öffnen und Dokument erzeugen
  Set wd = CreateObject("Word.Application")
  wd.Documents.Add
 
  ' Verweis auf RichTextBox in frmMain setzen
  Set Original = frmMain.rtfStory
 
  ' Array für "Alle ändern" und "Alle ignorieren" initialisieren
  ReDim arrAlwaysChange(1, 0)
  ReDim arrAlwaysIgnore(0)
 
  lblProgress.Caption = "0%"
  cmdReady.Enabled = False
End Sub

Private Sub Form_Activate()
  Static bWorking As Boolean
 
  ' Rechtschreibprüfung starten
  If Not bWorking Then
    bWorking = True
    Call Check
  End If
End Sub

Private Sub cmdAbort_Click()
  ' Abbrechen
  cmdAbort.Tag = "stop"
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de