[mso] Re: Word Macro to create list of acronyms
- From: "Tony Anderson" <tanders2112@xxxxxxxxxxx>
- To: mso@xxxxxxxxxxxxx
- Date: Wed, 25 Aug 2004 08:07:09 -0400
Lisa,
I have not had a chance to try out your work, but I am grateful for your
verygenerous efforts. I had a thought about a way to discern the difference
between a word and an acronym: if the characters appear in the spelling
dictionary, could we conclude that the characters are not an acronym? I
don't know if there is a way to do this from within a macro, but it was jsut
a thought. As for the style question, I was simply trying to avoid heading
styles, some of which force all characters to upper case.
I am really at a loss to express my gratitude for what you have already
accomplished. I had assumed that there would be some relatively simple way
to find acronyms through the search features available in Word. I guess I
was wrong! When I have a chance to use what you have done, I will be happy
to provide feedback. BTW, you said you are using a Dutch version. Are you
in Holland?
Thanks again,
Tony
>From: "Green" <1z@xxxxxxxxxxxxxx> >Reply-To: mso@xxxxxxxxxxxxx >To:
<mso@xxxxxxxxxxxxx> >Subject: [mso] Re: Word Macro to create list of
acronyms>Date: Tue, 24 Aug 2004 21:45:20 +0200 >>Tony, >>I was pretty
intrigued by your problem about acronyms and also a bit >miffed that my
previous code took so long. The code below processes by >word instead of
characters and is *much* quicker. It went through a 37 >page document in
under 3 secs. I'm not quite sure what you want to do >with acronyms that are
not in "normal" style like headings and so on >but there is a mechanism here
to seperate them out. I've not saved the >acronyms anywhere you can probably
figure that out for yourself but I >have highlighted them in Green for not
style=normal and Pink for >style=normal. >>I would appreciate some feedback
as to wether it works for you because >I'm using a Dutch version of word and
I am *very* interested in >multilanguage VBA. >>Public Sub
subCountAcronyms()>>Dim olWholeStory As Range* >Dim slAcronym As String >Dim
dbllT As Double* >Dim rlWord As Range* >Dim llWordCount As Long* >Dim
ilAcronymCount As Integer* >Dim ilChr1 As Integer* >Dim ilChr2 As Integer*
>Dim ilStyleAcronymCount As Integer* >Dim rlStyle As Style >Dim rlStyles As
Styles >Dim slNormalStyle As String* >>Application.DisplayStatusBar = True
>dbllT = Timer >Set olWholeStory = Selection.Range >olWholeStory.WholeStory
>>slNormalStyle =
>ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal >llWordCount
=0 >ilAcronymCount = 0 >ilStyleAcronymCount = 0 >>' Go through the Doc word
by word. >For Each rlWord In olWholeStory.Words > StatusBar =
rlWord.Text> llWordCount = llWordCount + 1 > If Len(rlWord) >1 Then
>> ilChr2 = Asc(Mid$(rlWord.Text, 2, 1)) > Select Case ilChr2 >
>>
Case Is <65, Is >90 > ' 2nd Chr Not upper case. > Case Else >
'2nd Chr is upper case. >> ilChr1 = Asc(Mid$(rlWord.Text, 1, 1)) >
n
Select Case ilChr1 > Case Is <65, Is >90 > ' 1st Chr Not
upper case. > Case Else > ' 1st Chr is upper case. >>
' Is the word in "normal" style? > If rlWord.Style <>slNormalStyle
Then > ilStyleAcronymCount = ilStyleAcronymCount + 1 >
rlWord.HighlightColorIndex = wdBrightGreen > Else >
rlWord.HighlightColorIndex = wdPink > End If >> ' Do
something with the acronym. > subWriteAcronym rlWord.Text >>
ilAcronymCount = ilAcronymCount + 1 > End Select > End Select >
End If >Next rlWord >>StatusBar = Round((Timer - dbllT), 1) _ > &"secs
" &llWordCount &" Words " _ > &ilAcronymCount &" Acronyms " _ >
&ilStyleAcronymCount &" Acronyms not in Normal Styale " >'
>********************************************************************** >*
>End Sub >Public Sub subWriteAcronym(spAcronym As String) > 'MsgBox
spAcronym >'
>********************************************************************** >*
>End Sub >>Regards >Lisa
>>>************************************************************* >You are
receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx >>To send mail to the group, simply address
it to mso@xxxxxxxxxxxxx >>To Unsubscribe from this group, send an email to
>mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the quotes)
in the subject line. >>Or, visit the group's homepage and use the dropdown
menu. This will also allow you to change your email settings to digest or
vacation (no mail). >//www.freelists.org/webpage/mso >>To be able to
usethe files section for sharing files with the group, send a request to
mso-moderators@xxxxxxxxxxxxx and you will be sent an invitation with
instructions. Once you are a member of the files group, you can go here to
upload/download files: >http://www.smartgroups.com/vault/msofiles
>*************************************************************
----------------------------------------------------------------------------
Express yourself instantly with MSN Messenger! Download today - it's FREE![1]
--- Links ---
1 http://g.msn.com/8HMAENUS/2734??PS=47575
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, send an email to
mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the quotes) in
the subject line.
Or, visit the group's homepage and use the dropdown menu. This will also allow
you to change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to use the files section for sharing files with the group, send a
request to mso-moderators@xxxxxxxxxxxxx and you will be sent an invitation with
instructions. Once you are a member of the files group, you can go here to
upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************
Other related posts:
