Rechtschreibprüfung im eigenen Programm Gibt es einen Texteditor, mit dem man die Rechschreibung prüfen kann? Jawohl, den gibt es. Er heißt Word, ist von Microsoft und kostet mindestens 140 Euro. Deshalb basteln wir einen Editor, der das auch kann…
Autor:  Marcus Woida	Bewertung:     [ Jetzt bewerten ]	Views:  26.876

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 3 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 5.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Gibt es einen Texteditor, mit dem man die Rechschreibung prüfen kann? Jawohl, den gibt es. Er heißt Word, ist von Microsoft und kostet mindestens 140 Euro. Deshalb basteln wir einen Editor, der das auch kann...

Die falschen Wörter in einem Text suchen und in eine ListBox einzutragen ist relativ einfach. Wir basteln aber die Luxus-Version. Mit Verbesserungsvorschlägen, "Immer ändern"- und "Immer ignorieren"-Option.

Jetzt der Haken an der Sache:
Unser Editor kostet auch mindestens 140 Euro.

Warum also das Ganze? Weil es Spaß macht.

Wir brauchen:

• Word
• 2 Formulare
• 1 RichTextBox
• 6 CommandButtons
• 2 Frames
• 2 Label
• 2 TextBoxen
• 1 ListBox
• 1 Progressbar

Man kann das Ganze auch mit einer normalen TextBox machen. Aber da man den Text mit höchsterWahrscheinlichkeit auch speichern möchte, ist die RichTextBox wesentlich bequemer:

Die SaveFile- und LoadFile-Methoden vereinfachen die entsprechenden Vorgänge erheblich.

Einrichten des Editor-Formulars

Eigenschaften:
Name: frmMain

Auf der Form legen wir eine RichTextBox mit Namen rtfStory und einenCommandButton (Name: cmdCheck, Caption "Prüfen") ab.

Der Code in dieser Form beschränkt sich auf ein Minimum:

Private Sub Form_Unload(Cancel As Integer)
  Set frmMain = Nothing
End Sub

Bevor frmCheck angezeigt wird, muss verhindert werden, dass während derRechtschreibprüfung der Text geändert werden kann:

Private Sub cmdCheck_Click()
  rtfStory.Locked = True
  Me.Enabled = False
  frmCheck.Show , Me
End Sub

Das Verhindern der Textänderung ist wichtig, da während der Prüfung der Text in ein Array eingelesen wird. Wenn man jetzt den Text ändert, fliegt einem alles um die Ohren, da die Position der Wörter nicht mehr stimmt.

Aufbau von Form2

Name: frmCheck
BorderStyle: 4 - festes Werkzeugfenster
ControlBox: False
StartUpPosition: 1 - Fenstermitte

Frame
Name: fraCheck
Caption: "nicht im Wörterbuch"

Textbox
Name: txtWrongWord
Locked: True

Frame
Name: fraSuggestion
Caption: "Vorschläge"

Listbox
Name: lstSuggestions

Label
Caption: "ersetzen mit"

Textbox
Name: txtNewWord

Progressbar
Name: ProgBar

Label
Name: lblProgress

6 CommandButtons
Name: cmdChange, Index 0 (Caption: "Ändern") und Index 1 (Caption"Alle ändern")
Name cmdIgnore, Index 0 (Caption: "Ignorieren") und Index 1 (Caption"Alle ignorieren")
Name cmdReady, Caption "Fertig", Enabled False
Name cmdAbort, Caption "Abbrechen", Enabled True

Die ControlBox der Form und cmdReady müssen auf jeden Fall Falsesein, da die Form nicht vor Beendigung der Rechtschreibprüfung geschlossenwerden darf. Andernfalls gibt es Probleme mit der Schleife For SearchWrong.

Formularentwurf: frmCheck

Vorbereitungen

Um mit Word, dem Text und den "Immer ändern"- und "Immer ignorieren"-Listen formularweit arbeitenzu können, definieren wir diese im Deklarationsbereich.

Option Explicit
 
' Verweis auf MS Word
Dim wd As Object
 
' Verweis auf RichTextBox in frmMain
Dim Original As RichTextBox
 
' dynamische Arrays für "Alle ändern"
' und "Alle ignorieren"
Dim arrAlwaysChange() As String
Dim arrAlwaysIgnore() As String

Beim Laden der Form wird das Ganze dann initialisiert und die Rechtschreibprüfung gestartet:

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

Wie Sie sehen, hat arrAlwaysChange zwei Dimensionen. Die erste Dimension beinhaltet im erstenIndex das falsche und im zweiten Index das richtige Wort. Die zweite Dimension ist die laufendeNummer. Das ist etwas unlogisch, hat aber den Grund, dass bei der erforderlichen Redimensionierungdes Arrays nur die letzte Dimension redimensioniert werden kann.

Für die eigentliche Rechschreibprüfung muss in Word kein neues Dokument erzeugt werden. Um an dieentsprechenden Vorschläge zu kommen, muss man aber diesen kleinen Umweg gehen. Mehr dazu später.

Im Form_Unload-Ereignis werden alle Verweise gelöscht und frmCheck wieder seinem ursprünglichenBesitzer übergeben:

Private Sub Form_Unload(Cancel As Integer)
  ' Word schließen und Verweis löschen
  wd.ActiveDocument.Close 0
  wd.Quit
  Set wd = Nothing
 
  ' Verweis auf RichTextBox in frmMain löschen
  Set Original = Nothing
 
  Set frmCheck = Nothing
End Sub

Rechtschreibprüfung starten

Die Rechtschreibprüfung wird im Sub Check abgehandelt. Dieses Sub schauen wir uns jetzt mal näher an:

Zunächst die Variablen:

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
 
  ...

Wenn ein falsches Wort gefunden wurde, wird es für die spätere Bearbeitung markiert. Damit VB weiß, wo es anfangen soll zu suchen, legen wir die Startposition fest:

  ...
  StartPos = 1

Jetzt muss der Text in einzelne Wörter gesplittet werden. Hier bietet sich das Leerzeichen als Trennzeichen an. Dazu werden vorher noch alle möglichen Zeilenumbrüche in Leerzeichen umgewandelt:

  ...
  Text = Replace(Original.Text, vbCrLf, " ")
  Text = Replace(Text, vbLf, " ")
  Text = Replace(Text, vbCr, " ")
  arrWords = Split(Text, " ")

Durch die Umwandlung der Zeilenumbrüche in Leerzeichen entstehen zwar mehr Leerzeichen als nötig. Das tut dem Ganzen aber keinen Abbruch. Jetzt noch schnell die ProgressBar eingerichtet und es kann losgehen:

  ...
  With Progbar
    .Min = 0
    .Max = UBound(arrWords) + 1
  End With

Max hat eins mehr als der größte Index von arrWords. Das ist dadurch bedingt, dass der erste Index von arrWords 0 ist. Die ProgressBar soll aber bei 1 anfangen zu zählen. Das wird am Ende der jetzt folgenden Schleife deutlich.

  ' Sicherstellen, dass das Wort im RTF-Text
  ' hervorgehoben wird
  Original.HideSelection = False

Zurücksetzen des Abbrechen-Flags:

  cmdAbort.Tag = ""

Zu Beginn der Schleife wird sichergestellt, dass der aktuelle Index ein Wort ist und dieses auf richtige Schreibweise geprüft:

  ...
  For SearchWrong = 0 To UBound(arrWords)
    If arrWords(SearchWrong) <> "" And SpellCheck(arrWords(SearchWrong)) = False Then
	  ...

Zu diesem Zweck übergeben wir das Wort an die Funktion SpellCheck:

Private Function SpellCheck(Word As String) As Boolean
  SpellCheck = wd.CheckSpelling(Word, , True)
End Function

wd.CheckSpelling wird hier als Application-Objekt eingesetzt und erwartet als ersten Parameter das zu prüfende Wort. Der optionale zweite Parameter gibt Pfad und Dateiname eines Benutzerwörterbuchs an. Der ebenfalls optionale dritte Parameter ignoriert bei True Wörter in Großbuchstaben (bspw. VISUAL BASIC). Ist er nicht angegeben, wird die in Word global gesetzte Eigenschaft verwendet (s. Word Menü "Extras / Optionen / Rechtschreibung und Grammatik", "Wörter in GROSSBUCHSTABEN ignorieren").

Wenn SpellCheck False zurückgibt, ist das geprüfte Wort falsch geschrieben. Damit ist die If-Abfrage erfüllt und wird entsprechend verarbeitet.

Zunächst wird mit

      ' immer noch Sub Check...
      WrongWord = GetTrueWord(arrWords(SearchWrong))

geprüft, ob am Ende des Wortes ein Satz- oder Sonderzeichen ist. Wenn ja, wird dieses entfernt:

Private Function GetTrueWord(WrongWord As String) As String
  Dim TmpASCII  As Long, StrLen As Long
 
  TmpASCII = Asc(Right$(WrongWord, 1))
  StrLen = Len(WrongWord)
 
  Select Case TmpASCII
    ' bei a -z, a - z, 0 - 9, ä, Ä, ö, Ö, ü, Ü, ß nichts tun
    Case 65 To 90, 47 To 122, 48 To 57, 228, 196, 246, 214, 252, 220, 223
      GetTrueWord = WrongWord
    ' bei anderen Zeichen letztes Zeichen entfernen
    Case Else
      GetTrueWord = Left$(WrongWord, StrLen - 1)
  End Select
End Function

Es gibt sicher nur wenige deutsche Worte, die mit Umlauten oder Zahlen enden. Dennoch ist es sinnvoll, das zu prüfen.

Dann wird das entsprechende Wort in der RichTextBox markiert (vorerst nicht sichtbar, da sie nicht den Focus hat) und die Startposition für die nächste Markierung gesetzt:

      ' immer noch Sub Check...
      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)

Jetzt wird noch geklärt, ob das falsche Wort in der "Immer ändern"- oder "Immer ingnorieren"-Liste steht:

      ' immer noch Sub Check...
      RetValChange = GetAlways(WrongWord)
      If RetValChange = -1 Then RetValIgnore = GetIgnore(WrongWord)

Ich weiß, was Sie jetzt denken. Und Sie haben Recht. Wir bemühen die Funktionen GetAlways und GetIgnore, wobei letztere nur aufgerufen wird, wenn das Wort nicht in der "Immer ändern"-Liste ist:

Private Function GetAlways(WrongWord As String) As Long
  Dim SearchAlways As Long
 
  For SearchAlways = 0 To UBound(arrAlwaysChange, 2)
    ' wenn Wort in Liste vorhanden
    If InStr(1, arrAlwaysChange(0, SearchAlways), WrongWord) > 0 Then
      GetAlways = SearchAlways
      Exit Function
    End If
  Next SearchAlways
 
  GetAlways = -1
End Function
 
Private Function GetIgnore(WrongWord As String) As Long
  Dim SearchAlways As Long
 
  For SearchAlways = 0 To UBound(arrAlwaysIgnore)
    ' wenn Wort in Liste vorhanden
    If InStr(1, arrAlwaysIgnore(SearchAlways), WrongWord) > 0 Then
      GetIgnore = SearchAlways
      Exit Function
    End If
  Next SearchAlways
 
  GetIgnore = -1
End Function

Die beiden Funktionen geben die jeweilige Position des Wortes im Array zurück.

Nachdem nun alles geprüft wurde, kann das Wort ersetzt werden - oder auch nicht:

      ' immer noch Sub Check...
      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

Wenn die erste If-Bedignung erfüllt ist, wird das Wort immer korrigiert. Dies geschieht automatisch. Die zweite If-Bedingung verfährt entsprechend mit Wörtern, die nie korrigiert werden sollen. Letztlich werden, wenn keines von beidem zutrifft, mit Hilfe des Subs GetSuggestions Verbesserungsvorschläge angefordert:

Private Sub GetSuggestions(WrongWord As String)
  Dim Sug As Integer
 
  txtWrongWord.Text = WrongWord
  ...

Im Folgenden wird ersichtlich, warum in Word ein neues Dokument erzeugt werden muss. Word kennt in VBA die GetSpellingSuggestion-Methode, an die man ein Wort übergeben kann und dann, so vorhanden, eine Liste mit Vorschlägen zurück bekommt. Da man außerhalb von Word auf diese Methode schwer zugreifen kann, wird das Wort in das Dokument eingefügt. Zuvor wird sichergestellt, dass bereits vorhandener Text gelöscht wird:

  With wd
    ' Text in Word-Dokument löschen
    .Selection.WholeStory
    .Selection.Delete
    ' ...und falsches Wort einfügen
    .Selection.TypeText Text:=WrongWord

Jetzt kann man mit der Words-Eigenschaft für dieses Wort die Vorschlagsliste erzeugen:

    ' wenn vorhanden, Verbesserungsvorschläge suchen
    If .ActiveDocument.Words(1).GetSpellingSuggestions.Count > 0 Then
      For Sug = 1 To .ActiveDocument.Words(1).GetSpellingSuggestions.Count
        lstSuggestions.AddItem .ActiveDocument.Words(1).GetSpellingSuggestions.Item(Sug).Name
      Next
 
      ' ersten Vorschlag in Textbox eintragen
      txtNewWord.Text = lstSuggestions.List(0)
      lstSuggestions.ListIndex = 0
    Else
      lstSuggestions.AddItem "keine Vorschläge gefunden"
    End If
  End With
End Sub

Wenn die Vorschläge eingetragen sind, wird der Fokus auf rtfStory gelegt, um den Fehler im Kontext anzuzeigen.

Nachdem das Sub abgearbeitet ist, ist die Schleife auch schon fast am Ende. In den If-Bedingungen If RetValChange > -1 und ElseIf RetValChange > -1 fällt auf, dass txtNewWord.Tag auf weiter gesetzt wird. Das ist unabdingbar, weil am Ende der Schleife auf eine Benutzeraktion gewartet wird:

      ' immer noch Sub Check...
      Do
        DoEvents
      Loop Until txtNewWord.Tag = "weiter" Or cmdAbort.Tag = "stop"
    End If
 
    ' Falls "Abbrechen"-Button gedrückt, Schleife verlassen 
    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
 
  ' Fertig-Button enablen
  cmdReady.Enabled = True
 
  ' Falls "Abbrechen"-Button gedrückt, Fenster jetzt schließen
  If cmdAbort.Tag = "stop" Then cmdReady.Value = True 
End Sub

Abschließend wird noch die ProgressBar aktualisiert.

Beim Klick auf den Abbrechen-Button wird die Tag-Eigenschaft auf "Stop" gesetzt. Die Tag-Eigenschaft selbst wird innerhalb der Schleife zur Rechtschreibprüfung stetig abgefragt, um den Vorgang ggf. beenden zu können.

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

Beim Klick auf den Button "Fertig" wird die Form geschlossen.

Private Sub cmdReady_Click()
  ' zurück zur MainForm
  frmMain.Enabled = True
  frmMain.rtfStory.Locked = False
  Unload Me
End Sub

Im Weiteren werfen wir einen Blick auf die Buttons "Korrigieren" und "Ignorieren".

Ändern / Immer ändern

Nachdem ein falsches Wort gefunden wurde, geschieht folgendes:

1. das falsche Wort wird in rtfStorry markiert und
2. in txtWrongWord angezeigt
3. lstSuggestions wird mit Vorschlägen gefüllt
4. das erste Wort der Liste wird in txtNewWord eingetragen

Private Sub lstSuggestions_Click()
  txtNewWord.Text = lstSuggestions.Text
End Sub

Jetzt hat man die Möglichkeiten, das Wort einmal oder immer zu korrigieren:

Private Sub cmdChange_Click(Index As Integer)
  Dim LastIndx As Long
 
  Select Case Index
    Case 1
      ' wenn "Alle ändern", Wort hinzufügen
      LastIndx = UBound(arrAlwaysChange, 2)
 
      arrAlwaysChange(0, LastIndx) = txtWrongWord.Text
      arrAlwaysChange(1, LastIndx) = txtNewWord.Text
 
      ' Array für nächsten Durchlauf neu dimensionieren
      ReDim Preserve arrAlwaysChange(1, LastIndx + 1)
  End Select
 
  With Original
    ' Bearbeitung des Textes ermöglichen
    .Locked = False
 
    ' falsches Wort korrigieren
    .SelRTF = txtNewWord.Text
 
    ' Bearbeitung des Textes sperren
    .Locked = True
  End With
 
  ' Hinweis, dass Sub Check fortfahren kann
  txtNewWord.Tag = "weiter"
End Sub

Wenn man sich entscheidet, das Wort immer zu korrigieren, wird der größte Index der zweiten Dimension in arrAlwaysChange ermittelt. Dann wird an diese Position im Index 0 der ersten Dimension das falsche Wort und im Index 1 die Korrektur abgelegt. Zum Schluss wird dann der Text in frmMain korrigiert.

Ignorieren / Immer ignorieren

Ähnlich funktionieren "Ignorieren" und "Immer ignorieren":

Private Sub cmdIgnore_Click(Index As Integer)
  Dim LastIndx As Long
 
  Select Case Index
    Case 1
      ' wenn "Alle ignorieren", Wort hinzufügen
      LastIndx = UBound(arrAlwaysIgnore)
 
      arrAlwaysIgnore(LastIndx) = txtWrongWord.Text
 
      ' Array für nächsten Durchlauf neu dimensionieren
      ReDim Preserve arrAlwaysIgnore(LastIndx + 1)
  End Select
 
  ' Hinweis, dass Sub Check fortfahren kann
  txtNewWord.Tag = "weiter"
End Sub

Hier wird lediglich das falsche Wort für einen späteren Vergleich im Array abgelegt und die Suche ohne Korrektur fortgesetzt. So, die Rechtschreibung ist jetzt abgeschlossen.