View Single Post
  #22   Report Post  
Posted to microsoft.public.word.docmanagement
lewisma lewisma is offline
external usenet poster
 
Posts: 16
Default Creating a Macro

OK, i'm getting there with this, upper/lower left i think are fine. Here is
what upper/lower right currently look like.

Extract 5 (upper right)

Extract 5 (lower right)

I need to move the symbols to the right of the number and take out the space
between the two. Is there any adjustment i can make so i can make both lines
slighlty longer ?
--
lewisma


"lewisma" wrote:

If i add a space in the find string after right (upper and lower) it takes
away 1 space but there is still one space left to remove, i tried adding 2
spaces at the end of right, but that doesn't change the phrase at all.
--
lewisma


"lewisma" wrote:

Works well, now looks like this

Extract 5

Extract 5

Extract 5

Extract 5

Just need to work out how to remove the space for lines 1 and 3 which is
upper/bottom right
--
lewisma


"Graham Mayor" wrote:

Are you sure that's it?

Locate the line
..Replacement.Font.Size = 14

and add the following immediately after it

Select Case i
Case 0
.Replacement.Font.Position = -4
Case 1
.Replacement.Font.Position = -4
Case 2
.Replacement.Font.Position = 4
Case 3
.Replacement.Font.Position = 4
Case Else
End Select

This will process each item of the original four in the replacement array in
order. Any others you have added to the end will not be affected.

As for moving the two items closer together add a space in the find strings
after both occurrences of 'left'
i.e.. "upper left " and "bottom left "

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org



lewisma wrote:
I know i'm being a pain, this is what it looks like so far.

Extract ? 5

Extract ? 5

Extract ? 5

Extract ? 5

Is it possible to close the spaces so there is not as much of a gap
between the symbol and the number, the top 2 phrases are upper so
they that symbol would need to go down 1 line and slighlty across and
the bottom 2 are for the lower phrase, looks like that needs to go up
1 line and slighlty across.
I want to see of i can align them a bit more accurately.

Thanks

You are welcome

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org



lewisma wrote:
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.

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
Word MVP web site http://word.mvps.org



lewisma wrote:
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

Glad you were able to get there in the end

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org



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

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 --
lewisma


"Graham Mayor" wrote:

http://www.gmayor.com/installing_macro.htm

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org



lewisma wrote:
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

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
Word MVP web site http://word.mvps.org



lewisma wrote:
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

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
Word MVP web site http://word.mvps.org