How can I set some style to the words without loss of original underline or bold or other?

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

avkokin - 14 Oct 2007 09:30 GMT

There is some text, which has a first words with underline or Bold or
Italicize. Different. How and can I employ to these words some style
BUT these words not must to lost my underline, bold or
italicize.Example (thanks Helmut Weber):
Sub Test455091()
Dim oRng As Range
For Each oRng In ActiveDocument.Sentences
With oRng.Words(1)
.style = ("MyStyle")
End With
Next
End Sub
But this code change my original style for first words.
How can I set some style to the words without loss of original
underline or bold or other?
Is such possible or not?

Reply to this Message

Graham Mayor - 14 Oct 2007 10:01 GMT

You can record the bold/italic/underline attributes (and any others that may
be relevant, apply your character style then re-add the saved attributes eg

Sub Test455092()
Dim oRng As Range
Dim aItalic As Boolean
Dim aBold As Boolean
Dim aUline As String
For Each oRng In ActiveDocument.Sentences
With oRng.Words(1)
aItalic = .Font.Italic
aBold = .Font.Bold
aUline = .Font.Underline
.Style = ("MyStyle")
.Font.Italic = aItalic
.Font.Bold = aBold
.Font.Underline = aUline
End With
Next
End Sub

Signature

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

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

> There is some text, which has a first words with underline or Bold or
> Italicize. Different. How and can I employ to these words some style
[quoted text clipped - 12 lines]
> underline or bold or other?
> Is such possible or not?

Reply to this Message

Helmut Weber - 14 Oct 2007 10:26 GMT

Hi Anton,

you could store all font properties
in a font object, which is a duplicate
of the font, before the style was applied,
and reapply the properties you would like to preserve.

Sub Test455091()
Dim rTmp As Range
Dim oRng As Range
Dim oFnt As Font
For Each oRng In ActiveDocument.Sentences
Set rTmp = oRng.Words(1)
With rTmp
If Right(rTmp, 1) = " " Then
.End = .End - 1
End If
Set oFnt = rTmp.Font.Duplicate
' ! store all font properties
' in a font object
.Style = "TestStyle"
.Select
.Font.Underline = oFnt.Underline
.Font.Bold = oFnt.Bold
.Font.Italic = oFnt.Italic
End With
Next
End Sub

As the trailing space is a part of a word,
which is rather confusing,
I thought, just in case, I'd shorten the range
by one character.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Reply to this Message

Helmut Weber - 14 Oct 2007 10:29 GMT

...

of course,
"select" is redundant, only a remainder from tests.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Reply to this Message

avkokin - 14 Oct 2007 15:18 GMT

> ...
>
[quoted text clipped - 8 lines]
> Win XP, Office 2003
> "red.sys" & Chr$(64) & "t-online.de"

Thank you very much. It good work.
However, my comrade has more complex case. There is sample document
(http://www.box.net/shared/34oq0tdfq4). First word is consist from few
style. Is it possible anything do for first word?

Reply to this Message

Helmut Weber - 14 Oct 2007 17:28 GMT

Hi Anton,

>However, my comrade has more complex case. There is sample document
>(http://www.box.net/shared/34oq0tdfq4). First word is consist from few
>style. Is it possible anything do for first word?

hmm... Possible?

Yes!

But quite a lot of tedious coding.
For a mixture of all possible styles
and every possible formatting, one would have
to remember formatting for each character
or sequences of equally formatted characters.

Easier said than done.
Use the sample I provided and
apply it to each character in words(1).

Pseudocode:

redim oFnt(1 to len(wordrange) as font
for i = i to len(wordrange)
ofnt(i) = wordrange.characters(i).font
next

Good luck.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Reply to this Message

Helmut Weber - 14 Oct 2007 17:57 GMT

Hi Anton,

so far so good, only in principle,
for the worst case.

This is terribly slow,
as it processes every character in every first word
in every sentence.

Sub Test455091()
Dim rTmp As Range
Dim rtmp1 As Range
Dim oRng As Range
Dim oFnt As Font
Dim lCnt As Long
For Each oRng In ActiveDocument.Sentences
Set rTmp = oRng.Words(1)
With rTmp
If Right(rTmp, 1) = " " Then
.End = .End - 1
End If
For lCnt = 1 To Len(rTmp)
Set rtmp1 = rTmp.Characters(lCnt)
Set oFnt = rtmp1.Font.Duplicate
rtmp1.Style = "TestStyle"
rtmp1.Font.Underline = oFnt.Underline
rtmp1.Font.Bold = oFnt.Bold
rtmp1.Font.Italic = oFnt.Italic
ActiveDocument.UndoClear
Next
End With
Next
End Sub

Not that easy!

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Reply to this Message