until beginning of document

[sarah]

In my code i am selecting all the text around where text is selected, that is
underlined.
However if the text is at the very start of the document it throws an error,
what code would i need to insert so that it does this unless/untill it hits
the start of the document??

Here's my code:

Dim lClr As Long
Dim rTmp As Range

Set rTmp = Selection.Range
lClr = Selection.Font.UnderlineColor

Do While rTmp.Previous.Font.UnderlineColor = lClr
rTmp.start = rTmp.start - 1
Loop

Do While rTmp.Next.Font.UnderlineColor = lClr
rTmp.End = rTmp.End + 1
Loop

 

[Helmut Weber]

Hi Sarah,

I thought about doc start and doc end,
but didn't want to bother you with complications.

Sub Makro1()
Dim lClr As Long
Dim rTmp As Range
Set rTmp = Selection.Range
lClr = Selection.Font.Color
On Error GoTo skipleft
While rTmp.Previous.Font.Color = lClr
rTmp.start = rTmp.start - 1
' rTmp.Select ' for testing
Wend
skipleft:
On Error GoTo skipright
While rTmp.Next.Font.Color = lClr
rTmp.End = rTmp.End + 1
' rTmp.Select ' for testing
Wend
skipright:
rTmp.Select
End Sub

Still not perfekt, as it would not behave
properly, I think, if all of the doc's mainstory
was in the same formatting.
But can all be handled, not a big problem.

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[sarah]

what should i do so that it continues to execute the code after where the
error occurred?

 

[Helmut Weber]

Hi Sarah,

instead of doing it the simple way,
and reacting to just any error,
one could check whether previous is
the range of the first character in the doc
or next is the range of the last character
in the doc, which is the end of doc mark.

Sub test9999()

Dim lClr As Long
Dim rTmp As Range

Set rTmp = Selection.Range
lClr = Selection.Font.UnderlineColor

Do While rTmp.Previous.Font.UnderlineColor = lClr
rTmp.start = rTmp.start - 1
If rTmp.start = 0 Then Exit Do
Loop

Do While rTmp.Next.Font.UnderlineColor = lClr
rTmp.End = rTmp.End + 1
If rTmp.End = ActiveDocument.Range.End Then
Exit Do
End If
Loop

rTmp.Select ' for testing
End Sub

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[sarah]

thanks for all your help thats perfect