| CODE |
Sub SpellCheck() Sub SpellCheckSelection(MSWord) Sub SpellCheckDocument(MSWord) Function SpellSelectionF(MSWord,lineOfText,fileName,lineNo) Function SplitLine(lineOfText) |
| CODE |
Sub SpellCheck() 'DESCRIPTION: Find the next comment. Set MSWord = CreateObject( "Word.Application") 'MSWord.visible = true 'uncomment this to see what's really happpening behind the scenes ' Add a document if there aren't any (needed to get suggestions). If MSWord.Documents.Count = 0 Then MSWord.Documents.Add if (ActiveDocument.Selection.Text = "") then SpellCheckDocument MSWord else SpellCheckSelection MSWord end if 'Kill document, don't leave it floating in memory MSWord.ActiveWindow.Close wdDoNotSaveChanges end Sub Sub SpellCheckSelection(MSWord) 'DESCRIPTION: Checks the spelling of the current selection startSearchLine = ActiveDocument.Selection.CurrentLine startSearchCol = ActiveDocument.Selection.CurrentColumn if (ActiveDocument.Selection.TopLine = ActiveDocument.Selection.BottomLine) then SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine else ActiveDocument.Selection.CharLeft ActiveDocument.Selection.CharRight lastLine = ActiveDocument.Selection.CurrentLine ActiveDocument.Selection.EndOfLine dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine lastLine = lastLine + 1 do while(lastLine < startSearchLine) ActiveDocument.Selection.CharRight ActiveDocument.Selection.EndOfLine dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine lastLine = lastLine + 1 loop ActiveDocument.Selection.CharRight ActiveDocument.Selection.MoveTo startSearchLine,startSearchCol,dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine end if end Sub Sub SpellCheckDocument(MSWord) 'DESCRIPTION: Checks the spelling of "comments" in the whole document startSearchLine = ActiveDocument.Selection.CurrentLine startSearchCol = ActiveDocument.Selection.CurrentColumn lastLine = startSearchLine Do if (ActiveDocument.Selection.findText("//.*", dsMatchRegExp) = false) then exit do if (ActiveDocument.Selection.CurrentLine < lastLine) then exit do lastLine = ActiveDocument.Selection.CurrentLine SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine Loop ActiveDocument.Selection.MoveTo startSearchLine,startSearchColumn lastLine = startSearchLine Do if (ActiveDocument.Selection.findText("/\*",dsMatchRegExp) = false) then exit do if (ActiveDocument.Selection.CurrentLine < lastLine) then exit do lastLine = ActiveDocument.Selection.CurrentLine lastCol = ActiveDocument.Selection.CurrentColumn if (ActiveDocument.Selection.findText("\*/",dsMatchRegExp) = false) then exit do endLine = ActiveDocument.Selection.CurrentLine endCol = ActiveDocument.Selection.CurrentColumn - 2 if (endLine = lastLine) then ActiveDocument.Selection.MoveTo lastLine,lastCol,dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine else ActiveDocument.Selection.MoveTo lastLine,lastCol ActiveDocument.Selection.EndOfLine dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine lastLine = lastLine + 1 do while(lastLine < endLine) ActiveDocument.Selection.CharRight ActiveDocument.Selection.EndOfLine dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine lastLine = lastLine + 1 loop ActiveDocument.Selection.CharRight ActiveDocument.Selection.MoveTo endLine,endCol,dsExtend SpellSelectionF MSWord,ActiveDocument.Selection.Text,ActiveDocument.FullName,ActiveDocument.Selection.CurrentLine end if loop ActiveDocument.Selection.MoveTo startSearchLine,startSearchCol End Sub Function SpellSelectionF(MSWord,lineOfText,fileName,lineNo) 'Converted from an example by Seth A. Robinson Dim colSuggestions Dim suggestion Dim txtFinal 'to hold the final results Dim txt_temp SplitLine lineOfText spaceArray = split(lineOfText,":",-1,1) ActiveDocument.Selection.CharRight for each spellWord in spaceArray TrimWord = Trim(spellWord) validWord = true if (Left(TrimWord,1) = "@") then validWord = false ' ignore parameters if (Left(TrimWord,1) = "$") then validWord = false ' ignore parameters if ((Left(TrimWord,1) = "<") And (Right(TrimWord,1) = ">")) then validWord = false ' ignore tags if (validWord) then If (MSWord.CheckSpelling(TrimWord) = false) Then 'Word is wrong, let's get some suggestions of right ones. Set colSuggestions = MSWord.GetSpellingSuggestions(TrimWord) txtFinal = fileName & "(" & lineNo & "): " & TrimWord & " ->" If colSuggestions.Count = 0 Then txtFinal = txtFinal & "(no suggestions)" Else For Each suggestion In colSuggestions txtFinal = txtFinal & suggestion.name & " | " Next end if PrintToOutputWindow(txtFinal) end if end if next End Function Function SplitLine(lineOfText) dim splt(7) dim replace(7) splt(0) = " " replace(0) = ":" splt(1) = " " ' Thats a tab character replace(1) = ":" splt(2) = "<" replace(2) = ":<" splt(3) = ">" replace(3) = ">:" splt(4) = "(" replace(4) = ":" splt(5) = ")" replace(5) = ":" splt(6) = "." replace(6) = ":" result = lineOfText index = 0 Do while (index < 7) splitV = split(result,splt(index),-1,1) result = Join(splitV,replace(index)) index = index + 1 Loop lineOfText = result end function |