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: Warum also das Ganze? Weil es Spaß macht. Wir brauchen:
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: 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 Frame Textbox Frame Listbox Label Textbox Progressbar Label 6 CommandButtons 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.
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:
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. Dieser Workshop wurde bereits 26.876 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats ![]() Dietrich Herrmann MSChart-WinForms Animation Dieser Tipp zeigt einen ersten Ansatz für die Animation von Charts in WindowsForms. Neu! sevCommand 4.0 ![]() Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
|||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |