[dba-Tech] FW: Word VBA question
Susan Harkins
ssharkins at gmail.com
Thu Nov 7 14:41:06 CST 2019
Moving the loop seemed to iterate correctly -- but nothing was entered in
the new document -- so although it didn't work, that is a nice clue.
Susan H.
I tried moving it to just after Execute -- that didn't work either.
Do While rng.Find doesn't work either.
Susan H
The Do... Loop will not execute since rng.Find.Found is false at the start.
A classic exampe of the difference between
DO WHILE
...
LOOP
versus
DO
.....
LOOP WHILE
Whaat happens if you move the DO WHILE to after the .Execute and the LOOP
before the final END WITH?
On 7 Nov 2019 at 14:37, Susan Harkins wrote:
> I had to let this go for awhile but I've got it mostly worked out,
> except for the right loop.
>
> This procedure creates a new document with a table for storing each
> acronym, its, definition, and the page number. Right now, it works
> fine for the first acronym found, but I can't get the loop correct to
> keep it going until it's found all of the acronyms.
>
> Any help?
>
> At this point, don't worry if the definition isn't exact. I haven't
> been able to test it for a full document -- can't do that until I can
> get the loop to work. In addition, it's rather ugly code -- I'll clean
> it up later.
>
> Code follows -- and thanks! - Susan H.
>
>
> Sub GetAcronyms()
> 'Create new document with acronyms, definitions, and page numbers for
> active document.
>
> Dim source As Document
> Dim target As Document
> Dim rng As Range
> Dim tbl As Table
> Dim strAnronym As String
> Dim strDefintion As String
> Dim intAcronym As Integer
> Dim strRngCopy As String
>
> Set source = ActiveDocument
> Set target = Documents.Add
>
> 'Add Table object to target document to organize anacronyms and
> definitions. With oDoc_Target
> Set tbl = target.Tables.Add(target.Range, 2, 3)
> With tbl
> 'Format the table a bit
> 'Insert headings
> .Range.Style = wdStyleNormal
> .AllowAutoFit = False
> .Cell(1, 1).Range.Text = "Acronym"
> .Cell(1, 2).Range.Text = "Definition"
> .Cell(1, 3).Range.Text = "Page"
> 'Set row as heading row
> .Rows(1).HeadingFormat = True
> .Rows(1).Range.Font.Bold = True
> .PreferredWidthType = wdPreferredWidthPercent
> .Columns(1).PreferredWidth = 20
> .Columns(2).PreferredWidth = 70
> .Columns(3).PreferredWidth = 10
> End With
> End With
>
> Set rng = source.Range
>
> 'Do While rng.Find.Found
> With rng.Find
> 'Use wildcard search to find strings consisting of two or more
> uppercase
> letters.
> .Text = "\(<[A-Z]{2,}>"
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = True
> .MatchWildcards = True
> 'Perform the search
> .Execute
> strAcronym = Right(rng, Len(rng) - 1)
> 'Length of strAcronym determines number of words preceding
> copied. 'Copy acronym definition. intAcronym = Len(strAcronym)
> rng.Select strDefinition = Selection.MoveLeft(wdWord,
> intAcronym + 2, True) strDefinition = Selection.Text
>
> 'Copy acronym, definition, and page number to target table.
> With tbl
> tbl.Select
> Selection.InsertRowsBelow 1
> tbl.Cell(2, 1).Range = strAcronym
> tbl.Cell(2, 3).Range.Text =
> rng.Information(wdActiveEndPageNumber)
> tbl.Cell(2, 2).Range.Text = strDefinition
> End With
>
> End With
> 'Loop
>
> End Sub
>
>
>
> -----Original Message-----
> From: dba-Tech <dba-tech-bounces at databaseadvisors.com> On Behalf Of
> Salakhetdinov Shamil via dba-Tech Sent: Saturday, August 31, 2019 8:09
> AM To: Discussion of Hardware and Software issues
> <dba-tech at databaseadvisors.com> Cc: Salakhetdinov Shamil
> <mcp2004 at mail.ru> Subject: Re: [dba-Tech] Word VBA question
>
> Hi Susan --
>
> I'm not sure what method do you use to find the abbreviation - here
> are two possible solution cases:
>
> *** First one ***
>
> Sub Macro1()
> Dim searchWord As String
> searchWord = "BBB"
> Dim sel As word.Selection
> Set sel = word.Application.Selection
> sel.ClearFormatting
> With sel.Find
> .Text = searchWord
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
>
> Dim wordFound As Boolean
> wordFound = sel.Find.Execute
> If wordFound Then
> Dim wordLength As Integer
> wordLength = Strings.Len(searchWord)
> Dim wdoc As word.Document
> Set wdoc = word.Application.ActiveDocument
>
> Dim wordIndex As Integer
> wordIndex = GetWordIndex(wdoc, sel.Words.First.Start) If (wordIndex >
> -1) Then Dim rangeToCopy As word.Range Set rangeToCopy =
> wdoc.Range(wdoc.Words(wordIndex - wordLength - 1).Start,
> wdoc.Words(wordIndex - 1).Start) Dim strToCopy As String strToCopy =
> Strings.Trim(rangeToCopy) Debug.Print "'" + strToCopy + "'" End If End
> If End Sub Function GetWordIndex(wdoc As word.Document,
> wordStartPosition As Integer) As Integer Dim wordIndex As Integer
> wordFound = False For wordIndex = 1 To wdoc.Words.Count If
> (wdoc.Words(wordIndex).Start = wordStartPosition) Then GetWordIndex =
> wordIndex Exit Function End If Next wordIndex
>
> GetWordIndex = -1
> End Function
> *** Second one ***
>
> Sub Macro2()
> Dim searchWord As String
> searchWord = "BBB"
>
> Dim wdoc As word.Document
> Dim wordIndex As Integer
> Dim wordFound As Boolean
>
> Set wdoc = word.Application.ActiveDocument wordFound = False For
> wordIndex = 1 To wdoc.Words.Count If (wdoc.Words(wordIndex) =
> searchWord) Then wordFound = True Exit For End If Next wordIndex
>
> If wordFound Then
> Dim wordLength As Integer
> wordLength = Strings.Len(searchWord)
> Dim rangeToCopy As word.Range
> Set rangeToCopy = wdoc.Range(wdoc.Words(wordIndex - wordLength -
> 1).Start, wdoc.Words(wordIndex - 1).Start) Dim strToCopy As String
> strToCopy = Strings.Trim(rangeToCopy) Debug.Print "'" + strToCopy +
> "'"
>
> End If
> End Sub HTH.
>
> -- Shamil
>
> P.S. I'm a rare guest here these days - if you have any questions on
> the subject please e-mail me directly.
>
>
> >Tuesday, August 6, 2019 12:21 AM +03:00 from Susan Harkins
> <ssharkins at gmail.com>:
> >
> >Hi everyone!
> >
> >I need to copy a range to a new Word document, but it's a complicated
> >search. When the search pattern find a match, I need to select the
> >words to the left -- using the length of the match (which can change,
> >I'm using wildcards). I'm stumped.
> >
> >An example:
> >
> >The search string matches (BBB) at the text, Better Business Bureau
> >(BBB). I need to copy the definition of the acronym, to the left of
> >BBB, and the acronym. The acronym is easy. But I can't figure out for
> >the life of me how to set a range to "three words to the left of
> >BBB".
> >
> >I'd like to avoid using Selection because the editors will be working
> >with big documents. If that's the only way it can be done, that's the
> >route I'll go. But I'd rather set a range -- just can' figure out how
> >to do
> it.
> >
> >Thanks!
> >Susan H.
> >
> >_______________________________________________
> >dba-Tech mailing list
> >dba-Tech at databaseadvisors.com
> >http://databaseadvisors.com/mailman/listinfo/dba-tech
> >Website: http://www.databaseadvisors.com
>
>
> --
> Salakhetdinov Shamil
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com
>
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com
>
_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com
More information about the dba-Tech
mailing list