![]() |
#6
|
|||
|
|||
![]()
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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
tomsrv | Word VBA | 13 | 08-24-2016 02:26 AM |
Ammunition count macro | Owastell | Excel Programming | 3 | 07-03-2014 11:00 AM |
![]() |
bpanda | Word VBA | 1 | 06-11-2013 07:17 AM |
![]() |
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 |