Thread: [Solved] Word Count Macro
View Single Post
 
Old 07-30-2017, 07:45 AM
gmaxey gmaxey is offline Windows 7 32bit Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,435
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Mana,

Word doesn't consider the concept of a "word" the same as you or me or most of the other 6 plus billion souls who use words.

Consider this simple four word paragraph:

Hey! That's my car!

If selected:

Code:
Sub Folly()
Dim lngIndex As Long
  MsgBox Selection.Words.Count
  For lngIndex = 1 To Selection.Words.Count
    MsgBox Selection.Words(lngIndex)
  Next
End Sub
Then there are hyphenated words and on and on. You could probably spend all day and still find conditions to deal with.

Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 7/30/2017
Dim oRng As Range
Dim lngIndex As Long
  Set oRng = ActiveDocument.Range
  oRng.Collapse wdCollapseStart
  Do
    For lngIndex = 1 To 25
      oRng.MoveEnd wdWord, 1
      'Deal with hyhenated words e.g., twenty-one
      On Error GoTo lbl_Skip
      If oRng.Characters.Last.Next = "-" And oRng.Characters.Last.Next.Next Like "[A-Za-z]" Then
        oRng.MoveEnd wdWord, 2
      End If
      'Deal with sentence punctuation.
      If oRng.Characters.Last.Next Like "[.,:;/?/!]" And oRng.Characters.Last.Next.Next Like "[" & Chr(11) & "," & Chr(13) & "]" Then
        oRng.MoveEnd wdWord, 1
      End If
      If oRng.Characters.Last Like " " And oRng.Characters.Last.Previous Like "[.,:;/?/!]" Then
        oRng.MoveEnd wdWord, 1
      End If
lbl_Skip:
      On Error GoTo 0
      If oRng.Text Like Chr(13) Then oRng.MoveEnd wdWord, 1
      If oRng.Text Like Chr(11) Then oRng.MoveEnd wdWord, 1
      If lngIndex = 25 Then
        oRng.Collapse wdCollapseEnd
        oRng.InsertBefore "~*~"
        oRng.Collapse wdCollapseEnd
      End If
      If oRng.End = ActiveDocument.Range.End - 1 Then Exit For
    Next
    If oRng.End = ActiveDocument.Range.End - 1 Then Exit Do
  Loop
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "~*~"
    .Replacement.Text = "/"
    .Execute Replace:=wdReplaceAll
  End With
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote