Snasui Excel Forum

Code: Select all

Function intWordCount(rng As Range) As Integer
    intWordCount = UBound(Split(Application.WorksheetFunction.Trim(rng.Value), " "), 1) + 1
End Function

Code: Select all

Function intWordCount(rng As Range) As Integer
    Dim wd As Object
    Dim doc As Object
    Dim ojbSelt As Object
    Set wd = CreateObject("Word.Application")
    Set doc = wd.documents.Add
    Set ojselt = wd.Selection
    ojselt.typetext Text:=rng.Value
    intWordCount = wd.activedocument.ComputeStatistics(Statistic:=wdStatisticWords, _
        IncludeFootnotesAndEndnotes:=True)
    wd.activedocument.Close False
    wd.Quit
End Function

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
Call CheckSpelling1(Target)
End Sub

Sub CheckSpelling1(r As Range)
Dim rng As Range
Dim ar() As String
Dim i As Long
Dim j As Long
With Application.SpellingOptions
   .IgnoreCaps = True
   .IgnoreFileNames = True
   .IgnoreMixedDigits = True
End With

   For Each rng In r
      If Not rng.HasFormula And VarType(rng.Value) = vbString Then
         ar = Split(Replace(rng.Value, Chr(160), " "), " ")
         j = 1
         rng.Font.ColorIndex = xlColorIndexAutomatic
         For i = 0 To UBound(ar)
            If Not Application.CheckSpelling(Word:=ar(i)) Then
               rng.Characters(j, Len(ar(i))).Font.ColorIndex = 3
            End If
            j = j + 1 + Len(ar(i))
         Next i
      End If
   Next rng
End Sub