TechWhirl (TECHWR-L) is a resource for technical writing and technical communications professionals of all experience levels and in all industries to share their experiences and acquire information.
For two decades, technical communicators have turned to TechWhirl to ask and answer questions about the always-changing world of technical communications, such as tools, skills, career paths, methodologies, and emerging industries. The TechWhirl Archives and magazine, created for, by and about technical writers, offer a wealth of knowledge to everyone with an interest in any aspect of technical communications.
Subject:RE: MS Word Tool and Management SIG From:"Steve Hudson" <steve -at- wright -dot- com -dot- au> To:"TECHWR-L" <techwr-l -at- lists -dot- raycomm -dot- com> Date:Fri, 12 Oct 2001 16:24:06 +1000
> 1. Does anyone know of a tool that will generate a list of all the words
that appear in an MS Word document? I know MS Word provides a count of the
words, but how do you see what those words are? I am wanting to use this
list to ensure that no one of the words in the document will create problems
for translation?
Ah ha - another user for my l10n tool for Word. I knew you would pop up some
day :-)
' Collect all unique words in document.
' By Steve Hudson
Sub GrabVocab()
Dim k As Long, l As Long, MyCount As Long
Dim gvWordList() As Variant
Dim s As String, gvTitle As String
Const gvDel As Variant = ""
With ActiveDocument
MyCount = .Words.Count
ReDim gvWordList(MyCount)
MyStatusBar MyCount, ""
For k = 1 To MyCount
MyStatusBar 0, "Get Word"
gvWordList(k) = LCase(.Words(k))
While Right$(gvWordList(k), 1) = " "
gvWordList(k) = Left$(gvWordList(k), Len(gvWordList(k)) - 1)
Wend
Next
MyCount = MyCount - KillDupes(gvWordList(), gvDel)
ReDim Preserve gvWordList(MyCount)
' remove spaces from end, change case, delete entries with special
characters
MyStatusBar MyCount, ""
For k = 1 To MyCount
MyStatusBar 0, "Validating new words."
For l = 1 To Len(gvWordList(k))
s = Mid$(gvWordList(k), l, 1)
If (s < "a" Or s > "z") And s <> "-" Then
gvWordList(k) = gvDel
Exit For
End If
Next
Next
gvTitle = .BuiltInDocumentProperties("Title") & "-Words"
Documents.Add
.BuiltInDocumentProperties("Title") = gvTitle
End With
With Selection
.InsertAfter gvTitle
.InsertParagraphAfter
.InsertParagraphAfter
For k = 1 To MyCount
.InsertAfter gvWordList(k)
.InsertParagraphAfter
Next
.Collapse
End With
End Sub
Public Sub MyStatusBar(Status As Long, MyPrompt As String)
' sets up a progressive count to use as a progress indicator through
large macros
' to set the max number or clear the status bar, call it with a positive
number
' to iterate, call it with a zero
Static i As Long
Static J As Long
If Status > 0 Then
J = Status
i = 0
StatusBar = ""
Else
i = i + 1
StatusBar = MyPrompt & " " & i & " / " & J
End If
ActiveDocument.UndoClear
End Sub
Public Sub ResetFind()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Text = ""
.Text = ""
End With
End Sub
Option Explicit
Public Sub ReReplaceAll(OldText As String, NewText As String)
Dim MyFlag As Boolean
ResetFind
With Selection.Find
.Text = OldText
.Replacement.Text = NewText
.Wrap = wdFindContinue
MyFlag = True
While MyFlag
MyFlag = False
Selection.HomeKey unit:=wdStory
While .Execute(Replace:=wdReplaceOne) = True
MyFlag = True
Wend
Wend
End With
End Sub
Public Sub BubbleSort(AnArray() As Variant)
If UBound(AnArray) < 2 Then Exit Sub
Dim Pass As Long
Pass = 0
While BubSortPass(AnArray(), Pass)
Wend
End Sub
Private Function BubSortPass(AnArray() As Variant, Pass As Long) As Boolean
Dim k As Long
BubSortPass = False
For k = 2 To UBound(AnArray) - Pass
If AnArray(k - 1) > AnArray(k) Then
Swap AnArray(k - 1), AnArray(k)
BubSortPass = True
End If
Next
Pass = Pass + 1
End Function
Public Function RemoveDeleted(AnArray() As Variant, DeleteMatch As Variant)
As Long
Dim k As Long
RemoveDeleted = 0
For k = 1 To UBound(AnArray)
If AnArray(k) = DeleteMatch Then
RemoveDeleted = RemoveDeleted + 1
Else
AnArray(k - RemoveDeleted) = AnArray(k)
End If
Next
End Function
Public Function KillDupes(AnArray() As Variant, DeleteEntry As Variant) As
Long
Dim k As Long, l As Long, u As Long
u = UBound(AnArray)
MyStatusBar UBound(AnArray) - 1, ""
For k = 2 To u
MyStatusBar 0, "Checking for duplicates"
For l = 1 To k - 1
If AnArray(l) = AnArray(k) Then
AnArray(k) = DeleteEntry
Exit For
End If
Next
Next
KillDupes = RemoveDeleted(AnArray(), DeleteEntry)
End Function
Public Sub Swap(a As Variant, B As Variant)
Dim Temp As Variant
Temp = a
a = B
B = Temp
End Sub
Steve Hudson
Principal Technical Writer
Wright Technologies (Aus)
steve -at- wright -dot- com -dot- au
(612) 9518-1822
The best way to predict the future... is to create it!
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Announcing new options for IPCC 01, October 24-27 in Santa Fe,
New Mexico: attend the entire event or select a single day.
For details and online registration, visit http://ieeepcs.org/2001
Your monthly sponsorship message here reaches more than
5000 technical writers, providing 2,500,000+ monthly impressions.
Contact Eric (ejray -at- raycomm -dot- com) for details and availability.
---
You are currently subscribed to techwr-l as: archive -at- raycomm -dot- com
To unsubscribe send a blank email to leave-techwr-l-obscured -at- lists -dot- raycomm -dot- com
Send administrative questions to ejray -at- raycomm -dot- com -dot- Visit http://www.raycomm.com/techwhirl/ for more resources and info.