Die CheckSpelling-Methode kann aufgerufen werden mit:
Neue Wörterbücher können hinzugefügt werden.
Wird als Ausdruck Application vorgegeben, kommt Syntax 2 zur Anwendung.
Sub CheckWord()
Dim sWorth As String
On Error GoTo ERRORHANDLER
sWorth = Range("A1").Value
If Not Application.CheckSpelling( _
word:=sWorth, _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox "Keine Entsprechung für das Wort " & sWorth & " gefunden!"
Else
MsgBox "Das Wort " & sWorth & " ist vorhanden!"
End If
Exit Sub
ERRORHANDLER:
Beep
MsgBox _
prompt:="Die Rechtschreibprüfung ist nicht installiert!"
End Sub
Sub SpellLanguage()
Dim lLang As Long
Dim sWorth As String
Dim bln As Boolean
lLang = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
If Left(Application.Version, 1) = "7" Then GoTo ERRORHANDLER1
On Error GoTo ERRORHANDLER2
sWorth = Range("A2").Value
If Not Range("A2").CheckSpelling( _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False, _
spelllang:=3081) Then
MsgBox "Keine Entsprechung für das Wort " & sWorth & " gefunden!"
Else
MsgBox "Das Wort " & sWorth & " ist entweder vorhanden" & vbLf & _
"oder es wurde keine Korrektur gewünscht!"
End If
bln = Range("A2").CheckSpelling("Test", spelllang:=lLang)
Exit Sub
ERRORHANDLER1:
MsgBox "Die Sprachfestlegung ist erst ab XL9 möglich!"
Exit Sub
ERRORHANDLER2:
Beep
MsgBox _
prompt:="Die Rechtschreibprüfung ist nicht installiert!"
End Sub
Bitte beachten: OLEObjekte lassen sich nicht über die CheckSpelling-Methode ansprechen, ihre Texte müssen ausgelesen werden.
Sub CheckTxtBoxA()
Dim oTxt As OLEObject
Dim arrWrd() As String, sTxt As String
Dim iCounter As Integer
For Each oTxt In ActiveSheet.OLEObjects
If TypeOf oTxt.Object Is MSForms.TextBox Then
sTxt = oTxt.Object.Text
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der TextBox " _
& oTxt.Name & " wurde nicht im Wörterbuch gefunden!"
End If
Next iCounter
End If
Next oTxt
End Sub
Sub CheckTxtBoxB()
If Application.CheckSpelling( _
word:=ActiveSheet.TextBoxes("txtSpelling").Text, _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox "Alle Wörter wurden gefunden!"
Else
MsgBox "Mindestens ein Wort wurde nicht gefunden!"
End If
End Sub
Bitte beachten: OLEObjekte lassen sich nicht über die CheckSpelling-Methode ansprechen, ihre Texte müssen ausgelesen werden.
Sub CheckTxtBoxC()
Dim arrWrd() As String, sTxt As String
Dim iCounter As Integer
sTxt = ActiveSheet.TextBoxes("txtSpelling").Text
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der TextBox " & _
"txtSpelling wurde nicht im Wörterbuch gefunden!"
End If
Next iCounter
End Sub
Sub CheckRange()
If Range("A4:A8").CheckSpelling Then
MsgBox "Entweder alle Wörter wurden gefunden" & vbLf & _
"oder es wurde keine Korrektur gewünscht!"
Else
MsgBox "Es wurden nicht alle Wörter aus dem Bereich A4:A8 gefunden!"
End If
End Sub
Sub CheckValidation()
Dim rng As Range
Dim arrWrd() As String, sTxt As String
Dim iCounter As Integer
Set rng = Range("A10")
If Abs(rng.Validation.Type) >= 0 Then
sTxt = rng.Validation.ErrorMessage
If sTxt <> vbNullString Then
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der Fehlermeldung " & _
"wurde nicht im Wörterbuch gefunden!"
End If
Next iCounter
End If
sTxt = rng.Validation.InputMessage
Erase arrWrd
If sTxt <> vbNullString Then
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der Eingabemeldung " & _
"wurde nicht im Wörterbuch gefunden!"
End If
Next iCounter
End If
End If
End Sub
Private Sub cmdSpelling_Click()
Dim arrWrd() As String, sTxt As String, sWhole As String
Dim lChar As Long
Dim iCounter As Integer
sTxt = txtSpelling.Text
sWhole = sTxt
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der TextBox " & _
"txtSpelling wurde nicht im Wörterbuch gefunden!"
lChar = InStr(sWhole, arrWrd(iCounter))
Exit For
End If
Next iCounter
If lChar > 0 Then
With txtSpelling
.SetFocus
.SelStart = lChar - 1
.SelLength = Len(arrWrd(iCounter))
End With
End If
End Sub
Private Sub cmdSpelling_Click()
Dim arrWrd() As String, sTxt As String, sWhole As String
Dim lChar As Long
Dim iCounter As Integer
sTxt = txtSpelling.Text
sWhole = sTxt
arrWrd = MySplit(sTxt, " ")
For iCounter = 1 To UBound(arrWrd)
If Not Application.CheckSpelling( _
word:=arrWrd(iCounter), _
customdictionary:="BENUTZER.DIC", _
ignoreuppercase:=False) Then
MsgBox arrWrd(iCounter) & " aus der TextBox " & _
"txtSpelling wurde nicht im Wörterbuch gefunden!"
lChar = InStr(sWhole, arrWrd(iCounter))
Exit For
End If
Next iCounter
If lChar > 0 Then
With txtSpelling
.SetFocus
.SelStart = lChar - 1
.SelLength = Len(arrWrd(iCounter))
End With
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Application.DisplayAlerts = False
Target.CheckSpelling
Application.DisplayAlerts = True
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick( _
ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then
Cancel = True
Application.DisplayAlerts = False
Target.CheckSpelling
Application.DisplayAlerts = True
End If
End Sub
Der nachfolgende Code muß in die Personl.xls eingegeben werden, damit er für alle nach Sitzungsstart zu öffnenden und zu schließenden Arbeitsmappen Gültigkeit hat.
Dim xlApplication As New clsApp
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set xlApplication.xlApp = Nothing
End Sub
Private Sub Workbook_Open()
Set xlApplication.xlApp = Application
Call CreateCmdBar
End Sub
Public WithEvents xlApp As Excel.Application
Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, _
Cancel As Boolean)
Dim wks As Worksheet
For Each wks In Wb.Worksheets
wks.CheckSpelling
Next
End Sub