Creating a Macro

L

lewisma

Hi

I need to create a macro which will look through word documents. The macro
will need to look for certain words which are (upper right, upper left,
bottom right and bottom left). These words will then need to be replaced by
some kind of autoshape/symbol.
Upper right would need to become |_
Upper left would need to become _|
Bottom right would need to become | with a line on the right hand side (at
the top)
Bottom left would need to become | with a line on the left hand side (at the
top)
The autoshape/symbol also needs to be active so the typist can type in a
number of 1-8 in the box, this is a dental grid. I know how to record macros
and i am happy finding and replacing words, but this is proving quite
difficult to achieve. Is there any sort of vb script out there that will
accomplish this, what is the best way to get the end result. I am very new to
VB so my knowledge is very limited.
Any help would be very much appreciated. Thanks in advance

lewisma

lewisma
 
G

Graham Mayor

It is easy enough to run through a document and process a list of words or
phrases, but the problem here is the autoshape and more particularly your
requirement to have a shape that you can write in. The logical shape would
be a table cell, to which you could apply borders to produce the four shapes
and type in the space, but you cannot intersperse table cells with text -
each cell would have to be on its own line.

Text boxes etc are out because you cannot format the edges of the box
individually.

You could use (say) the characters 195/196 199/200 from the Wingdings font,
which would provide suitably adventurous shapes, but you wouldn't be able to
type in the spaces - only alongside.

To do that -

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
vFindText = Array("upper right", "upper left", _
"lower right", "lower left")
vReplText = Array(Chr(200), Chr(199), Chr(196), Chr(195))
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Replacement.Font.name = "Wingdings"
.Replacement.Font.Size = 14
.Execute Replace:=wdReplaceAll
Next i
End With
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
L

lewisma

Graham

Many thanks for your quick response. I have just been told that the shape
does not need to have anything typed into it now. So all that needs to be
done is for the phrases to be replaced by the shape. Does this make the end
result a little easier now ?
Look forward to your comments, thanks
 
L

lewisma

I copied and pasted your script into a new word macro, when i try to run it i
get the following error message.

Compile Error: Expected End Sub

Below is the script.

Sub lewis()
'
' lewis Macro
' Macro created 18/08/2008 by MedQuist
'
Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
vFindText = Array("upper right", "upper left", _
"lower right", "lower left")
vReplText = Array(Chr(200), Chr(199), Chr(196), Chr(195))
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Replacement.Font.Name = "Wingdings"
.Replacement.Font.Size = 14
.Execute Replace:=wdReplaceAll
Next i
End With
End With
End Sub


End Sub

Any ideas what i'm doing wrong here ?
Your help is appreciated, thanks
 
G

Graham Mayor

If you can find suitable characters and substitute them in and the font they
are derived from in the macro I posted, it will do just that.. Digging
around in Unicode fonts for some suitable shape I came up with the following
which uses box drawing shapes from the Arial Unicode font, which is a fairly
standard font that you will have.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
vFindText = Array("upper left", "upper right", "lower left", "lower right")
vReplText = Array(ChrW(9496), ChrW(9492), ChrW(9488), ChrW(9484))
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Replacement.Font.name = "Arial"
.Replacement.Font.Size = 14
.Execute Replace:=wdReplaceAll
Next i
End With
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
G

Graham Mayor

You should have pasted it *over* rather than into the macro.
http://www.gmayor.com/installing_macro.htm

Remove the lines

Sub lewis()
'
' lewis Macro
' Macro created 18/08/2008 by MedQuist
'
and the final
End Sub

and you may prefer the second version, which is nearer your requirement.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
L

lewisma

After some playing about i now have it working, but when i run the macro
inside word it only changes the upper right and upper left phrases, it
doesn't do anything for the bottom right and bottom left values, once that is
working i guess i just need to figure out what to replace the phrases with,
the font looks ok but i would really need the 2 lines for each phrase.

Thanks
 
L

lewisma

Graham

This is fantastic, i will give it a try, what's the best way to get the
script into a macro, before i just went into Word/Macro and Create Macro,
named it and just pasted in the script, should i be doing it that way or is
there another way to do this ?
Thanks
 
L

lewisma

Sorry i didn't spot the link when i read your reply. OK i have tested this
and it seems to work really well, how do i get the script to change for
bottom right/left. It only changes the upper phrases but this is definatly
looking good, i really appreciate your help with this
 
L

lewisma

Fantastic, i noticed on the script the wording was lower instead of bottom,
changed that and it looks great
 
G

Graham Mayor

Glad you were able to get there in the end :)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
L

lewisma

This is fantastic, great job, one last thing if i wanted to add another
phrase in which would be something like everything or all (this would be for
upper right/left and lower right/left) i think they would require the +
symbol for this to allow for everything, how do i add that into the current
working script

Many thanks
 
G

Graham Mayor

The phrases and their replacements are configured in the two arrays

vFindText = Array("upper left", "upper right", "lower left", "lower right")
vReplText = Array(ChrW(9496), ChrW(9492), ChrW(9488), ChrW(9484))

The order in the first list corresponds with the order in the second list,
with each item separated by a comma. You can use plain text or character
strings. If you use the former you would surround the text with straight
quotes as shown in the first line. In the second line I have used the
unicode numbers for the characters in the extended character set of the
Arial font.

If you are looking up suitable characters use the Insert Symbol command and
browse through those available. Character 265B might be suitable. Having
chosen the character note the HEX number - here 265B, which you need to
convert to its decimal equivalent. The simplest way to do that is to use the
Windows Calculator in its Scientific view. With the Hex button checked, type
in 265B, then click the Dec button and if you have done it correctly you
would get 9819. So for that character you would enter ChrW(9819).

If you want a simple + sign then add "+" to the replace string instead - or
if you prefer ChrW(43)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
L

lewisma

Graham

Fantastic, your a genius, works like a charm, many many thanks for your help
with this, it would have taken me forever to figure this all out.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top