Sub AutoOpen()
    NumberOfWords
End Sub
 
Sub NumberOfWords()
    Dim lngWords As Long
    Dim myRange As Range
    Dim lngLimit As Long
     
    lngLimit = 10
     
    With Word.Application
        If .Windows.Count > 0 Then
            Set myRange = ActiveDocument.Content
            lngWords = myRange.ReadabilityStatistics(1).Value
            .Caption = Format(lngWords, "##,##0") & " words - Microsoft Word"
            If lngWords > lngLimit Then
                Set myRange = Selection.Range
                myRange.WholeStory
                myRange.Font.ColorIndex = wdRed
            Else
                Set myRange = Selection.Range
                myRange.WholeStory
                myRange.Font.ColorIndex = wdBlack
            End If
        Else
            .Caption = "Microsoft Word"
        End If
        .OnTime Now + TimeValue(OnTm(lngWords)), "NumberOfWords"
    End With
End Sub
 
Private Function OnTm(ByVal lngWd As Long) As String
    Select Case lngWd \ 1000
        Case 0 To 10
            OnTm = "00:00:01"
        Case 11 To 20
            OnTm = "00:00:05"
        Case 21 To 30
            OnTm = "00:00:10"
        Case 31 To 40
            OnTm = "00:00:15"
        Case Else
            OnTm = "00:00:20"
    End Select
End Function