Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #6  
Old 08-01-2017, 07:19 AM
gmaxey gmaxey is offline Word Count Macro Windows 7 32bit Word Count Macro Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,617
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

mana,

You seem to have a good handle on dictionaries ;-)

If we conclude that a word is something that is delimited in a document by white space then the following may get us closer to a workable solution:

Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 8/1/2017
Dim oWord As Range
Dim oRng As Word.Range
Dim lngCount As Long
Dim lngIndex As Long
Dim lngMark As Long
  
  lngCount = InputBox("Enter the number of words to count", "Word Count", "25")
   With ActiveDocument
    For lngIndex = .Comments.Count To 1 Step -1
      If InStr(.Comments(lngIndex).Range.Text, "[Word Count:") > 0 Then
        .Comments(lngIndex).Delete
      End If
    Next
    Set oRng = ActiveDocument.Range
  End With
  lngMark = 0
  Do
    For Each oWord In oRng.Words
      If oWord.InRange(oRng) Then
        If Not fcnIsWhiteSpace(oWord) Then
          lngIndex = lngIndex + 1
          Do Until fcnIsWhiteSpace(oWord.Characters.Last) Or fcnIsWhiteSpace(oWord.Characters.Last.Next)
            oWord.MoveEnd wdWord, 1
            oRng.Start = oWord.Duplicate.End
          Loop
          Do While fcnIsWhiteSpace(oWord.Characters.Last) Or oWord.Characters.Last Like "[)}:;./?/!" & Chr(148) & "," & Chr(34) & "]"
            oWord.MoveEnd wdCharacter, -1
           Loop
          Do Until oWord.Characters.Last <> "]"
            oWord.MoveEnd wdCharacter, -1
          Loop
          If lngIndex = lngCount Then
            lngMark = lngMark + lngIndex
            lngIndex = 0
            oRng.Comments.Add oWord, "[Word Count: " & lngMark & "]"
          End If
        End If
      End If
    Next
  Loop Until oRng.End = ActiveDocument.Range.End
  'Here is where we coudld convert the comments to "instring" flags as the OP requested.
'  For lngIndex = ActiveDocument.Comments.Count To 1 Step -1
'    If Left(ActiveDocument.Comments(lngIndex).Range.Text, 11) = "[Word Count" Then
'      Set oRng = ActiveDocument.Comments(lngIndex).Reference
'      oRng.InsertAfter "/"
'      ActiveDocument.Comments(lngIndex).Delete
'    End If
'  Next
lbl_Exit:
  Exit Sub
End Sub

Private Function fcnIsWhiteSpace(oRngEndCharacter As Range) As Boolean
  'If its nothing the it isn't whitespace!
  fcnIsWhiteSpace = False
  If Not oRngEndCharacter Is Nothing Then
    Select Case AscW(oRngEndCharacter.Text)
      Case 8194, 8195, 8197, 9, 11, 13, 32, 160: fcnIsWhiteSpace = True
    End Select
  End If
End Function
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Word Count Macro Macro to return a word count of text contained within a bookmark tomsrv Word VBA 13 08-24-2016 02:26 AM
Ammunition count macro Owastell Excel Programming 3 07-03-2014 11:00 AM
Word Count Macro A recurring word count macro? bpanda Word VBA 1 06-11-2013 07:17 AM
Word Count Macro Word Count Macro bpanda Word VBA 1 01-11-2013 06:51 PM
*Word 2007 Macro for Character Count gbartlet Word 0 07-21-2010 11:12 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:01 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft