'In a module (Module1.bas)
Option Explicit
'Copyright © 2005 by RobDog888 (VB/Office Guru™). All Rights reserved.
'
'Distribution: You can freely use this code in your own
' applications provided that this copyright
' is left unchanged, but you may not reproduce
' or publish this code on any web site, online
' service, or distribute as source on any
' media without express permission.
'
'Early binding:
'Add a reference to MS Word xx.0 Object Library
'Modifications: none.
'Late binding:
'No references needed to any version of Word
'Modifications: Change object vars definitions (moApp & oDoc) to Object
'Change constants to their numeric equilivalents.
'Requirements:
'MS Word version 97 (8.0) - 2003 (11.0)
Public moApp As Word.Application
Private mbKillMe As Boolean
Public Property Get KillMe() As Boolean
InitializeMe
KillMe = mbKillMe
End Property
Public Property Let KillMe(Value As Boolean)
mbKillMe = Value
End Property
Public Sub InitializeMe()
On Error Resume Next
'<INITIALIZE WORD>
Set moApp = GetObject(, "Word.Application")
If TypeName(moApp) <> "Nothing" Then
Set moApp = GetObject(, "Word.Application")
Else
Set moApp = CreateObject("Word.Application")
mbKillMe = True
End If
End Sub
Public Function SpellMe(ByVal msSpell As String) As String
On Error GoTo No_Bugs
Dim oDoc As Word.Document
Dim iWSE As Integer
Dim iWGE As Integer
Dim sReplace As String
Dim lResp As Long
If msSpell = vbNullString Then Exit Function
InitializeMe
Select Case moApp.Version
Case "9.0", "10.0", "11.0"
Set oDoc = moApp.Documents.Add(, , 1, True)
Case "8.0"
Set oDoc = moApp.Documents.Add
Case Else
MsgBox "Unsupported Version of Word.", vbOKOnly + vbExclamation, "VB/Office Guru™ SpellChecker™"
Exit Function
End Select
Screen.MousePointer = vbHourglass
App.OleRequestPendingTimeout = 999999
oDoc.Words.First.InsertBefore msSpell
iWSE = oDoc.SpellingErrors.Count
iWGE = oDoc.GrammaticalErrors.Count
'<CHECK SPELLING AND GRAMMER DIALOG BOX>
If iWSE > 0 Or iWGE > 0 Then
'<HIDE MAIN WORD WINDOW>
moApp.Visible = False
If (moApp.WindowState = wdWindowStateNormal) Or (moApp.WindowState = wdWindowStateMaximize) Then
moApp.WindowState = wdWindowStateMinimize
Else
moApp.WindowState = wdWindowStateMinimize
End If
'</HIDE MAIN WORD WINDOW>
'<PREP CHECK SPELLING OPTIONS DIALOG BOX (MODIFY TO YOUR PREFERENCES)>
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.CheckGrammarWithSpelling = True
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.SuggestSpellingCorrections = True
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreUppercase = True
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreInternetAndFileAddresses = True
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreMixedDigits = False
moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.ShowReadabilityStatistics = False
'</PREP CHECK SPELLING OPTIONS DIALOG BOX (MODIFY TO YOUR PREFERENCES)>
'<DO ACTUAL SPELL CHECKING>
moApp.Visible = True
moApp.Activate
lResp = moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Display
'</DO ACTUAL SPELL CHECKING>
If lResp < 0 Then
moApp.Visible = True
MsgBox "Corrections Being Updated!", vbOKOnly + vbInformation, App.ProductName
Clipboard.Clear
oDoc.Select
oDoc.Range.Copy
sReplace = Clipboard.GetText(1)
'<FIX FOR POSSIBLE EXTRA LINE BREAK AT END OF TEXT>
If (InStrRev(sReplace, Chr(13) & Chr(10))) = (Len(sReplace) - 1) Then
sReplace = Mid$(sReplace, 1, Len(sReplace) - 2)
End If
'</FIX FOR POSSIBLE EXTRA LINE BREAK AT END OF TEXT>
SpellMe = sReplace
ElseIf lResp = 0 Then
MsgBox "Spelling Corrections Have Been Canceled!", vbOKOnly + vbCritical, "VB/Office Guru™ SpellChecker"
SpellMe = msSpell
End If
Else
MsgBox "No Spelling Errors Found" & vbNewLine & "Or No Suggestions Available!", vbOKOnly + vbInformation, _
"VB/Office Guru™ SpellChecker"
SpellMe = msSpell
End If
'</CHECK SPELLING AND GRAMMER DIALOG BOX>
oDoc.Close False
Set oDoc = Nothing
'<HIDE WORD IF THERE ARE NO OTHER INSTANCES>
If KillMe = True Then
moApp.Visible = False
End If
'</HIDE WORD IF THERE ARE NO OTHER INSTANCES>
Screen.MousePointer = vbNormal
Exit Function
No_Bugs:
If Err.Number = "91" Then
Resume Next
ElseIf Err.Number = "462" Then
MsgBox "Spell Checking Is Temporary Un-Available!" & vbNewLine & "Try Again After Program Re-Start.", _
vbOKOnly + vbInformation, "ActiveX Server Not Responding"
Screen.MousePointer = vbNormal
ElseIf Err.Number = 429 Then
Set moApp = Nothing
Resume Next
Else
MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbInformation, App.ProductName
Screen.MousePointer = vbNormal
End If
End Function
'*********************************************************
'Example usage:
'Behind a form (Form1)
'
'Add a single or multi-line textbox to your form
'Add a command button (Command1) to invoke the spell checking.
Option Explicit
Private Sub Command1_Click()
'<SPELL CHECK>
Text1.Text = SpellMe(Text1.Text)
End Sub
Private Sub Form_Load()
'<CALL THE SPELLME INITIALIZATION PROCEDURE BEFORE ANY USE>
InitializeMe
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If KillMe = True Then
moApp.Quit False
End If
Set moApp = Nothing
End Sub