Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.word.docmanagement
|
|||
|
|||
In Word, word usage
In Word, can you get a "report" or something similar to let you know which
words you use most? |
#2
Posted to microsoft.public.word.docmanagement
|
|||
|
|||
In Word, word usage
Use the following macro
Sub WordFrequency() Dim SingleWord As String 'Raw word pulled from doc Const maxwords = 9000 'Maximum unique words allowed Dim Words(maxwords) As String 'Array to hold unique words Dim Freq(maxwords) As Integer 'Frequency counter for Unique Words Dim WordNum As Integer 'Number of unique words Dim ByFreq As Boolean 'Flag for sorting order Dim ttlwds As Long 'Total words in the document Dim Excludes As String 'Words to be excluded Dim Found As Boolean 'Temporary flag Dim j, k, l, Temp As Integer 'Temporary variables Dim tword As String ' ' Set up excluded words ' Excludes = "[the][a][of][is][to][for][this][that][by][be][and][are]" Excludes = "" Excludes = InputBox$("Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Excludes = Excludes & InputBox$("The following words are excluded: " & Excludes & ". Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Find out how to sort ByFreq = True Ans = InputBox$("Sort by WORD or by FREQ?", "Sort order", "FREQ") If Ans = "" Then End If UCase(Ans) = "WORD" Then ByFreq = False End If Selection.HomeKey Unit:=wdStory System.Cursor = wdCursorWait WordNum = 0 ttlwds = ActiveDocument.Words.Count Totalwords = ActiveDocument.Words.Count ' Control the repeat For Each aword In ActiveDocument.Words SingleWord = Trim(aword) If SingleWord "A" Or SingleWord "z" Then SingleWord = "" 'Out of range? If InStr(Excludes, "[" & SingleWord & "]") Then SingleWord = "" 'On exclude list? If Len(SingleWord) 0 Then Found = False For j = 1 To WordNum If Words(j) = SingleWord Then Freq(j) = Freq(j) + 1 Found = True Exit For End If Next j If Not Found Then WordNum = WordNum + 1 Words(WordNum) = SingleWord Freq(WordNum) = 1 End If If WordNum maxwords - 1 Then j = MsgBox("The maximum array size has been exceeded. Increase maxwords.", vbOKOnly) Exit For End If End If ttlwds = ttlwds - 1 StatusBar = "Remaining: " & ttlwds & " Unique: " & WordNum Next aword ' Now sort it into word order For j = 1 To WordNum - 1 k = j For l = j + 1 To WordNum If (Not ByFreq And Words(l) Words(k)) Or (ByFreq And Freq(l) Freq(k)) Then k = l Next l If k j Then tword = Words(j) Words(j) = Words(k) Words(k) = tword Temp = Freq(j) Freq(j) = Freq(k) Freq(k) = Temp End If StatusBar = "Sorting: " & WordNum - j Next j ' Now write out the results tmpName = ActiveDocument.AttachedTemplate.FullName Documents.Add Template:=tmpName, NewTemplate:=False Selection.ParagraphFormat.TabStops.ClearAll With Selection For j = 1 To WordNum .TypeText Text:=Words(j) & vbTab & Trim(Str(Freq(j))) & vbCrLf Next j End With ActiveDocument.Range.Select Selection.ConvertToTable Selection.Collapse wdCollapseStart ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1) ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Word" ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Occurrences" ActiveDocument.Tables(1).Range.ParagraphFormat.Ali gnment = wdAlignParagraphCenter ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Total words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Totalwords ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Number of different words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Trim(Str(WordNum)) System.Cursor = wdCursorNormal ' j = MsgBox("There were " & Trim(Str(WordNum)) & " different words ", vbOKOnly, "Finished") Selection.HomeKey wdStory End Sub -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Cheri" wrote in message ... In Word, can you get a "report" or something similar to let you know which words you use most? |
#3
Posted to microsoft.public.word.docmanagement
|
|||
|
|||
In Word, word usage
Doug Robbins - Word MVP wrote: Use the following macro Sub WordFrequency() Dim SingleWord As String 'Raw word pulled from doc Const maxwords = 9000 'Maximum unique words allowed Dim Words(maxwords) As String 'Array to hold unique words Dim Freq(maxwords) As Integer 'Frequency counter for Unique Words Dim WordNum As Integer 'Number of unique words Dim ByFreq As Boolean 'Flag for sorting order Dim ttlwds As Long 'Total words in the document Dim Excludes As String 'Words to be excluded Dim Found As Boolean 'Temporary flag Dim j, k, l, Temp As Integer 'Temporary variables Dim tword As String ' ' Set up excluded words ' Excludes = "[the][a][of][is][to][for][this][that][by][be][and][are]" Excludes = "" Excludes = InputBox$("Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Excludes = Excludes & InputBox$("The following words are excluded: " & Excludes & ". Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Find out how to sort ByFreq = True Ans = InputBox$("Sort by WORD or by FREQ?", "Sort order", "FREQ") If Ans = "" Then End If UCase(Ans) = "WORD" Then ByFreq = False End If Selection.HomeKey Unit:=wdStory System.Cursor = wdCursorWait WordNum = 0 ttlwds = ActiveDocument.Words.Count Totalwords = ActiveDocument.Words.Count ' Control the repeat For Each aword In ActiveDocument.Words SingleWord = Trim(aword) If SingleWord "A" Or SingleWord "z" Then SingleWord = "" 'Out of range? If InStr(Excludes, "[" & SingleWord & "]") Then SingleWord = "" 'On exclude list? If Len(SingleWord) 0 Then Found = False For j = 1 To WordNum If Words(j) = SingleWord Then Freq(j) = Freq(j) + 1 Found = True Exit For End If Next j If Not Found Then WordNum = WordNum + 1 Words(WordNum) = SingleWord Freq(WordNum) = 1 End If If WordNum maxwords - 1 Then j = MsgBox("The maximum array size has been exceeded. Increase maxwords.", vbOKOnly) Exit For End If End If ttlwds = ttlwds - 1 StatusBar = "Remaining: " & ttlwds & " Unique: " & WordNum Next aword ' Now sort it into word order For j = 1 To WordNum - 1 k = j For l = j + 1 To WordNum If (Not ByFreq And Words(l) Words(k)) Or (ByFreq And Freq(l) Freq(k)) Then k = l Next l If k j Then tword = Words(j) Words(j) = Words(k) Words(k) = tword Temp = Freq(j) Freq(j) = Freq(k) Freq(k) = Temp End If StatusBar = "Sorting: " & WordNum - j Next j ' Now write out the results tmpName = ActiveDocument.AttachedTemplate.FullName Documents.Add Template:=tmpName, NewTemplate:=False Selection.ParagraphFormat.TabStops.ClearAll With Selection For j = 1 To WordNum .TypeText Text:=Words(j) & vbTab & Trim(Str(Freq(j))) & vbCrLf Next j End With ActiveDocument.Range.Select Selection.ConvertToTable Selection.Collapse wdCollapseStart ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1) ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Word" ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Occurrences" ActiveDocument.Tables(1).Range.ParagraphFormat.Ali gnment = wdAlignParagraphCenter ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Total words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Totalwords ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Number of different words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Trim(Str(WordNum)) System.Cursor = wdCursorNormal ' j = MsgBox("There were " & Trim(Str(WordNum)) & " different words ", vbOKOnly, "Finished") Selection.HomeKey wdStory End Sub -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Cheri" wrote in message ... In Word, can you get a "report" or something similar to let you know which words you use most? Doug, Thanks much, though I hadn't asked for this (or even thought of it). This is very cool! I've made some commented modifications to your code, below: Sub WordFrequency() ' posted by Doug Robbins, Word MVP in microsoft.public.word.docmanagement on 6-Dec-05 ' CLN (Blue Hornet) added code to: ' 1. show all words in lower case (so that "Any" "any", etc.) ' 2. bold and 'headerize' the "Words" / "Occurrence" cells in the table ' 3. show the sort order appended to "Occurence" ' 4. include common words in default "Exclude" InputBox Dim SingleWord As String 'Raw word pulled from doc Const maxwords = 9000 'Maximum unique words allowed Dim Words(maxwords) As String 'Array to hold unique words Dim Freq(maxwords) As Integer 'Frequency counter for Unique Words Dim WordNum As Integer 'Number of unique words Dim ByFreq As Boolean 'Flag for sorting order Dim ttlwds As Long 'Total words in the document Dim Excludes As String 'Words to be excluded Dim Found As Boolean 'Temporary flag Dim j, k, l, Temp As Integer 'Temporary variables Dim tword As String ' ' Set up excluded words ' Excludes = "[the][a][of][is][to][for][this][that][by][be][and][are]" ' Excludes = "" Excludes = InputBox$("Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "[the][a][an][of][is][to][for][this][that][by][be][and][are][all]") ' Excludes = Excludes & InputBox$("The following words are excluded: " & Excludes & ". Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Find out how to sort ByFreq = True ANS = InputBox$("Sort by WORD or by FREQ?", "Sort order", "FREQ") If ANS = "" Then End If UCase(ANS) = "WORD" Then ByFreq = False End If Selection.HomeKey Unit:=wdStory System.Cursor = wdCursorWait WordNum = 0 ttlwds = ActiveDocument.Words.Count Totalwords = ActiveDocument.Words.Count ' Control the repeat For Each aword In ActiveDocument.Words SingleWord = Trim(LCase(aword)) If SingleWord "A" Or SingleWord "z" Then SingleWord = "" 'Out of range? If InStr(Excludes, "[" & SingleWord & "]") Then SingleWord = "" 'On exclude list? If Len(SingleWord) 0 Then Found = False For j = 1 To WordNum If Words(j) = SingleWord Then Freq(j) = Freq(j) + 1 Found = True Exit For End If Next j If Not Found Then WordNum = WordNum + 1 Words(WordNum) = SingleWord Freq(WordNum) = 1 End If If WordNum maxwords - 1 Then j = MsgBox("The maximum array size has been exceeded. Increase maxwords.", vbOKOnly) Exit For End If End If ttlwds = ttlwds - 1 StatusBar = "Remaining: " & ttlwds & " Unique: " & WordNum Next aword ' Now sort it into word order For j = 1 To WordNum - 1 k = j For l = j + 1 To WordNum If (Not ByFreq And Words(l) Words(k)) Or (ByFreq And Freq(l) Freq(k)) Then k = l Next l If k j Then tword = Words(j) Words(j) = Words(k) Words(k) = tword Temp = Freq(j) Freq(j) = Freq(k) Freq(k) = Temp End If StatusBar = "Sorting: " & WordNum - j Next j ' Now write out the results tmpName = ActiveDocument.AttachedTemplate.FullName Documents.Add Template:=tmpName, NewTemplate:=False Selection.ParagraphFormat.TabStops.ClearAll With Selection For j = 1 To WordNum .TypeText Text:=Words(j) & vbTab & Trim(Str(Freq(j))) & vbCrLf Next j End With ActiveDocument.Range.Select Selection.ConvertToTable Selection.Collapse wdCollapseStart ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1) ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Word" ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Occurrences, by " & ANS ActiveDocument.Tables(1).Range.ParagraphFormat.Ali gnment = wdAlignParagraphCenter ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Total words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Totalwords ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Number of different words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Trim(Str(WordNum)) System.Cursor = wdCursorNormal ' j = MsgBox("There were " & Trim(Str(WordNum)) & " different words ", vbOKOnly, "Finished") Selection.HomeKey wdStory ' Bold the top row and set it to a repeating header row Selection.Tables(1).Select Selection.HomeKey Unit:=wdStory Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Rows.HeadingFormat = wdToggle Selection.Font.Bold = wdToggle Selection.HomeKey Unit:=wdStory End Sub |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
apply a template to existing documents | Page Layout | |||
Does Word have Keyboard Merges like Word Perfect does? | Mailmerge | |||
Word2000 letterhead merge | Mailmerge | |||
Underscore (_) will not always display in RTF files (Word 2002). | Microsoft Word Help | |||
Boiletplates from Word Perfect | Microsoft Word Help |