Spell check a VBA or VB6 ActiveX textbox

Martin LissKeep everyone healthy; Get Vaccinated
CERTIFIED EXPERT
Almost 50 years of programming experience. Click '+ More' in my "Full Biography" to see links to some articles I've written.
Published:
Updated:
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that follows allows you to easily do just that.

A few things to note about the code.

o Microsoft Word must be installed on your PC and on any of your users' PCs in order for this code to work
o No Reference to Word is required in your application
o The code as shown will check spelling but you can also have it check grammar by changing the  objDoc.CheckSpelling line  to objDoc.CheckGrammar
o You can replace the textbox with a RichTextbox if you like and the code will work with it as well
o In Excel you will need to remove the App.OleRequestPendingTimeout = 999999 line
o The code expects an ActiveX textbox named "Text1" and an ActiveX command button named "SpellCheck"

 
Private Sub SpellCheck_Click()
                      
                          Dim objWord As Object
                          Dim objDoc  As Object
                          Dim strResult As String
                          Const QUOTE = """"
                          
                          On Error GoTo ErrorRoutine
                      
                          App.OleRequestPendingTimeout = 999999
                          Set objWord = GetObject("Word.Application")
                          If TypeName(objWord) <> "Nothing" Then
                              ' Word is already open
                              Set objWord = GetObject(, "Word.Application")
                          Else
                              ' Create an instance of Word
                              Set objWord = CreateObject("Word.Application")
                          End If
                      
                          Select Case objWord.version
                              'Office 2000 and later
                              Case "9.0", "10.0", "11.0", "14.0", "15.0"
                                  Set objDoc = objWord.Documents.Add(, , 1, True)
                              'Office 97
                              Case "8.0"
                                  Set objDoc = objWord.Documents.Add
                              Case Else
                                  MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.version _
                                         & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
                                  Exit Sub
                          End Select
                      
                          objDoc.Content = Text1.Text
                          objDoc.CheckSpelling
                          objWord.Visible = False
                      
                          strResult = Left(objDoc.Content, Len(objDoc.Content) - 1)
                          ' Reformat carriage returns
                          strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10))
                          
                          If Text1.Text = strResult Then
                              ' There were no errors, so give the user a
                              ' visual signal that something happened
                              MsgBox "No changes made", vbInformation + vbOKOnly, "Spelling Checker"
                          End If
                          
                          'Clean up
                          objDoc.Close False
                          Set objDoc = Nothing
                          objWord.Application.Quit True
                          Set objWord = Nothing
                      
                          ' Replace the selected text with the corrected text. It's important that
                          ' this be done after the "Clean Up" because otherwise there are problems
                          ' with the screen not repainting
                          Text1.Text = strResult
                      
                          Exit Sub
                      
                      
                      ErrorRoutine:
                      
                          Select Case Err.Number
                              Case -2147221020
                                  ' There's no instance of Word so continue processing in order to create one
                                  Resume Next
                              Case 429
                                  MsgBox "Word must be installed in order for this code to work", vbCritical + vbOKOnly, "Spelling Checker"
                          End Select
                      
                      End Sub
                      

Open in new window


The following is a picture of the code in action. (Talking about 'action', the desktop picture behind the spell checker is me being tossed out of a boat while white water river rafting:) )

Spellcheck.jpg     
When the code is run, misspelled words are colored red and so after I clicked the 'Spell Check' button the word "nicly" was highlighetd in be red by Word.

If you have any comments, questions or problems please let me know.
 
Finally, if you find that this article has been helpful, please click the “thumb’s up” button below. Doing so lets me know what is valuable for EE members and provides direction for future articles. It also provides me with positive feedback in the form of a few points. Thanks!
6
9,543 Views
Martin LissKeep everyone healthy; Get Vaccinated
CERTIFIED EXPERT
Almost 50 years of programming experience. Click '+ More' in my "Full Biography" to see links to some articles I've written.

Comments (1)

For Office 365 apps, you will need to adjust line 22 to add 16.0 as such:

Case "9.0", "10.0", "11.0", "14.0", "15.0" , "16.0"

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.