VBWTool Utility - Now with "Highlight" function

[aconybeare]

Hi,

I've attempted to integrate RobDog888's Advanced VB/Office Guru™ SpellChecker™ into Martin's spellCheck script. It's not perfect, so if anyone would like to test it please go ahead; any suggestions or fixes will be welcomed

I've tested it with W2K and Office 10 (2002)

To test open C:\WINNT\Vb-World
Make a copy of SpellCheck.htm rename it to SpellCheck.old
Then paste the code below into SpellCheck.htm and save, create a test page with a textarea on it enter some text select it, right click it and choose SpellCheck.

<!--
+---------------------------------------------------------------------------+
    VB-WORLD Forums - Tagging Scripts 1.0
    Martin Liss
    Integrated with RobDog's Advanced VB/Office Guru SpellChecker
    [url]http://www.vbforums.com/showthread.php?t=350402[/url]
    Function:    Spell Checker v2.0
    Description: This script uses Microsoft Word to check the spelling in
                 posts. Word is assumed to be present.
 
+---------------------------------------------------------------------------+
-->
 
<script type="text/vbscript">
Const wdWindowStateNormal=0
Const wdWindowStateMaximize=1
Const wdWindowStateMinimize=2
Const wdDialogToolsSpellingAndGrammar=828
 
Dim objWindow
Dim objSource
Dim objSelect
Dim objSelectRange
 
Set objWindow = window.external.menuArguments
Set objSource = objWindow.event.srcElement
Set oDocument = objWindow.document
Set objSelect = oDocument.selection
Set objSelectRange = objSelect.createRange()
 
If objSource.tagName = "TEXTAREA" And Len(objSelectRange.text)>0 Then
    Dim sc: Set sc = New SpellChecker
    objSelectRange.text=sc.CheckThis(objSelectRange.text)
    Set sc=Nothing
End If
 
 
Class SpellChecker
    Dim moApp, mbKillMe
 
    Public Property Get KillMe()
        KillMe = mbKillMe
    End Property
 
    Public Property Let KillMe(Value)
        mbKillMe = Value
    End Property
 
    Private Sub Class_Initialize()
        On Error Resume Next
        '<INITIALIZE WORD>
        Set moApp = GetObject(, "Word.Application")
        'window.alert(TypeName(moApp))
        If TypeName(moApp) = "Empty" Or TypeName(moApp) = "Nothing" Then
            ' Word is not currently running.
            ' launch it and set flag to close it when done
            Set moApp = CreateObject("Word.Application")
            mbKillMe = True
        End If
    End Sub
 
    Private Sub Class_Terminate()
        If KillMe = True Then
            moApp.Quit False
        End If
        Set moApp=Nothing
    End Sub
 
    Public Function CheckThis(ByVal msSpell)
        On Error GoTo 0 'Resume Next
 
        Dim oDoc 'As Word.Document
        Dim iWSE 'As Integer
        Dim iWGE 'As Integer
        Dim sReplace 'As String
        Dim lResp 'As Long
 
        If msSpell = "" Then Exit Function
        'window.alert(TypeName(moApp) & vbNewLine & moApp.Version)
        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
                window.alert("Unsupported version of word.")' & moApp.Version)
                Exit Function
        End Select
 
        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
                window.alert("Applying corrections!")
                Call Window.ClipboardData.SetData("Text","") 'Clipboard.Clear
 
                oDoc.Select
                oDoc.Range.Copy
                sReplace = Window.ClipboardData.GetData("Text") '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>
                CheckThis = sReplace
            ElseIf lResp = 0 Then
                window.alert("Spelling corrections have been canceled!")
                CheckThis = msSpell
            End If
        Else
            window.alert("No spelling errors found or no suggestions available!")
            CheckThis = 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>
 
        If Err.Number <> 0 Then
            If Err.Number = "91" Then
                'Resume Next
            ElseIf Err.Number = "462" Then
                window.alert("Spell checking is temporary un-available!  Try again after program re-start.")
            ElseIf Err.Number = 429 Then
                Set moApp = Nothing
                'Resume Next
            Else
                window.alert(Err.Number & " " & Err.Description)
            End If
        End If
    End Function
End Class
</script>