I'm having a problem where the WORD window for CHECK SPELLING doesn't always appear on top of my app.
I've isolated the code into this simple example - create a new project with two textboxes - TEXT1 and TEXT2 - make both multi-line
Put this code into FORM1
Now enter something in TEXT1 and TAB to TEXT2 - so the LOST FOCUS event calls the WORD object to check the spelling.Code:Public objWord As Object Private Sub Text1_LostFocus() Call CheckSpelling(Text1) End Sub Private Sub Text2_LostFocus() Call CheckSpelling(Text2) End Sub Public Function CheckSpelling(t As TextBox) On Error GoTo Err_Handler ' Dim objWord As Object Dim objDoc As Object Dim strResult As String 'Create a new instance of word Application If (Len(t.Text) = 0) Then 'nahhhhhhhhhhh Else App.OleRequestPendingTimeout = 999999 If objWord Is Nothing Then Set objWord = CreateObject("word.Application") objWord.Visible = False Select Case objWord.Version 'Office 2000, xp, 2k3 Case "9.0", "10.0", "11.0" Set objDoc = objWord.Documents.Add(, , 1, True) 'Office 97 Case Else Set objDoc = objWord.Documents.Add End Select objDoc.Content = t.Text objDoc.CheckSpelling objWord.Visible = False strResult = Left(objDoc.Content, Len(objDoc.Content) - 1) 'correct the carriage returns strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10)) If t.Text = strResult Then ' There were no spelling errors, so give the user a ' visual signal that something happened 'MsgBox "The spelling check is complete.", vbInformation + vbOKOnly, "Spelling Complete" 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 t.Text = strResult End If Done: Exit Function 'in case user does not have word... Err_Handler: MsgBox Err.Description & Chr(13) & Chr(13) & "Please note you must have Microsoft Word installed to utilize the spell check feature.", vbCritical, "Error #: " & Err.Number Resume Done End Function




Reply With Quote