I don't know if you are still watching, but I briefly had a look at your
requirements soon after your message was posted. I could not see an easy way
to do what you asked, and then I forgot about it.
However having spotted it again, I took another look and I believe the
following may come close to what you require. The 'dictionary' comprises a
two column table in a document defined at sFname.
The first column contains words to tag, the second contains words to skip.
If a word is found that is not in the table, you get the choice to tag that
word. If you choose 'yes' the word is added to the first column and tagged.
If you select no, it is added to the second column and skipped. If you
choose Cancel the start of the word is bookmarked to allow you to resume
from the same position later.
The macro is a two stage process. The first stage colours all the tagged
words red. The second stage removes the colour and adds the prefix text.
The macro is annotated so that you can see how it works.
http://www.gmayor.com/installing_macro.htm
Sub TagWords()
Dim oWord As Variant
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oCell As Cell
Dim rCell As Range
Dim oRng As Range
Dim rTag As Range
Dim i As Long
Dim sFname As String
Dim bFound As Boolean
Dim bAdded As Boolean
Dim sTag As String
Dim sAsk As String
'define the prefix text to add to the tagged words
sTag = "<tag>"
'define the name and path to the dictionary document
sFname = "D:\My Documents\Test\Changes.doc"
'name the active document
Set oDoc = ActiveDocument
'open and name the dictionary document
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
'name the table containing the words to be tagged or skipped
Set oTable = oChanges.Tables(1)
'mark the document as a range
Set oRng = oDoc.Range
'If the macro has previously been run and
'paused there will be a bookmark
'Locate that bookmark if it exists and move
'the start of the range to the bookmark
If oDoc.Bookmarks.Exists("LastWord") = True Then
oRng.Start = oDoc.Bookmarks("LastWord").Range.End
End If
'Check each word in the range for an upper case first letter
For Each oWord In oRng.Words
bFound = False
If Asc(Left(oWord, 1)) >= 65 And _
Asc(Left(oWord, 1)) <= 90 Then
'if found check if the word is in the first column of the table
For i = 1 To oTable.Rows.Count
If InStr(1, oTable.Cell(i, 1).Range, Trim(oWord)) Then
'if it is colour it red
oWord.Font.Color = wdColorRed
'and set a flag to mark it as found
bFound = True
Exit For
End If
Next i
If bFound = False Then
'the word was not in the first column, so check the second
For i = 1 To oTable.Rows.Count
If InStr(1, oTable.Cell(i, 2).Range, Trim(oWord)) Then
oRng.Start = oWord.End
'and if found set a flag to mark it as found
bFound = True
Exit For
End If
Next i
End If
If bFound = False Then
'the word was not in the table
oWord.Select
'so ask the user what to do with it
sAsk = MsgBox("Tag " & oWord & "?", vbYesNoCancel)
If sAsk = vbYes Then
'The user has asked to tag the word
bAdded = False
'so colour it red
oWord.Font.Color = wdColorRed
'and add it to the first empty cell in column 1
For Each oCell In oTable.Columns(1).Cells
If Len(oCell.Range) = 2 Then
Set rCell = oCell.Range
rCell.End = rCell.End - 1
rCell.Text = oWord
'and set flag to mark it as entered
bAdded = True
Exit For
End If
Next oCell
If bAdded = False Then
'there were no empty cells so add one and
'insert the word in the new row
oTable.Rows.Add
Set rCell =
oTable.Columns(1).Cells(oTable.Rows.Count).Range
rCell.End = rCell.End - 1
rCell.Text = oWord
End If
End If
If sAsk = vbNo Then
'the user responded no
bAdded = False
'so add the word to the first empty cell of column 2
For Each oCell In oTable.Columns(2).Cells
If Len(oCell.Range) = 2 Then
Set rCell = oCell.Range
rCell.End = rCell.End - 1
rCell.Text = oWord
'and set a flag to mark it as entered
bAdded = True
Exit For
End If
Next oCell
If bAdded = False Then
'there were no empty cells so add one and
'insert the word in the new row
oTable.Rows.Add
Set rCell =
oTable.Columns(2).Cells(oTable.Rows.Count).Range
rCell.End = rCell.End - 1
rCell.Text = oWord
End If
End If
If sAsk = vbCancel Then
'the user selected Cancel
'so add a bookmark in front of the word
oWord.End = oWord.Start
oWord.Bookmarks.Add "LastWord"
'and quit the macro
Exit Sub
End If
End If
End If
Next oWord
'Now find all the red colured words
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Color = wdColorRed
Do While .Execute(Forward:=True) = True
'remove the red colour
oRng.Font.Color = wdColorAutomatic
'and insert the prefix text
oRng.InsertBefore sTag
oRng.Collapse wdCollapseEnd
Loop
End With
'close the dictionary with the added words saved.
oChanges.Close wdSaveChanges
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
OK, I don't know for sure if I have the right to post the code (it's
not mine for most), so here is at least the scenario.
The macro searches for the next word beginning with a capital letter.
The question is: do we need to insert a sequence of characters before
that word or not. To determine that, two ways :
1) a dictionary, containing the words to "tag", and the words NOT to "tag".
2) User response, if the word is not present in the dictionary.
The user will say, by one-letter commands, if he wants the word to be
tagged here, always, not here, or never. The goal would be to have a way
for the macro (same if possible) to rely only on the dictionary, without
user input.
When the user is requested a command, he can interrupt the macro by
pressing Escape. He can run it later from the point ha stopped it :
that's what I would like to have a chance to do even if I launched it in
a non-interactive way. I thought I woula have missed a basic point, but
considering my first question and your first response, I presume it's
not so basic.
Hoping I provided some useful new clues even so...
J.-F.
Graham Mayor a écrit :
