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

[avkokin]

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?

 

[Graham Mayor]

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


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


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Helmut Weber]

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.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Helmut Weber]

....

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

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[avkokin]

...

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

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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?

 

[Helmut Weber]

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.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Helmut Weber]

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!

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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