Strikethrough every nth word

[gillmcd]

Hi,

This code toggles strikethrough for selected text.

Sub StrikeIt()
Selection.Font.StrikeThrough = wdToggle
End Sub

I would like to select text and strike through every 5th word.

Not sure how to approach it.

Any help much appreciated.

 

[Doug Robbins - Word MVP]

Dim i As Long
For i = 1 To Selection.Words.Count Step 5
Selection.Words(i).Font.StrikeThrough = True
Next i


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[gillmcd]

Many thanks that's a huge help.

I notice that "Selection.Words." counts punctuation marks and the
space at the end of a sentence as a "word".

Is it possible to exclude those elements. I've tried other properties
but didn't make any progress.

Thanks again

 

[Helmut Weber]

Hi gillmcd,

depending on the kind of text,
e.g. invoice versus narrative,
you'd have to set up your own definition of "word".

As pointed out often before:
"Word" and "Sentence" are *fuzzy* concepts
of *fuzzy* natural language.

However, as this is a group about programming,
you might like to play with this one,
which highlights words according to the implemented definition.

Usable, I think for a narrative.
It would define "H2SO" as a word contained in "H2SO4".
It ain't that easy.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Larry]

This seems to work. If the word begins with any of the punctuation in the
select case statement, the macro strikes out the next word instead, and then
just continues.

Dim i As Long
For i = 1 To Selection.Words.Count Step 5
X = True
Select Case Selection.Words(i).Characters.First
Case Chr(13), ".", ",", ":", "!", "?", " ", "-", ")", "(", """",
Chr(30), Chr(151), _
Chr(147), Chr(148)
X = False
End Select

If X = True Then
Selection.Words(i).Font.StrikeThrough = True
Else
Selection.Words(i + 1).Font.StrikeThrough = True
End If

Next i

Larry

 

[Larry]

However, if in rare cases you have an instance of punctuation immediately
following another punctuation (say, a close quote immediately followed by an
open parentheses), then the parentheses will be struck out. So I added an
additional step which performs the same check on Selection.Words (i+1) as on
Selection.Words (i).

This is not elegant (and probably someone could come up with a more
economical way of doing this), but in my tests of it, it works.

Dim i As Long
For i = 1 To Selection.Words.Count Step 5
X = True
Select Case Selection.Words(i).Characters.First
Case Chr(13), ".", ",", """", ":", "!", "?", " ", "-", _
")", "(", Chr(30), Chr(151), Chr(147), Chr(148)
X = False
End Select

If X = True Then
Selection.Words(i).Font.StrikeThrough = True
Else

X = True
Select Case Selection.Words(i + 1).Characters.First
Case Chr(13), ".", ",", """", ":", "!", "?", " ", "-", _
")", "(", Chr(30), Chr(151), Chr(147), Chr(148)
X = False
End Select

If X = True Then
Selection.Words(i + 1).Font.StrikeThrough = True
Else
Selection.Words(i + 2).Font.StrikeThrough = True
End If
End If
Next i

 

[clickmagundi]

Hi,

That suits my needs perfectly - thank you all for your help.

It is great tool for plain language editing.

 

[gillmcd]

Thank you all for your help. This is perfect for my needs.

 

[Greg Maxey]

I am not claiming this is any more elegant or economical, but I prefer
using a range and the method you have provided also strikes out the
trailing space after each fifth word. Testing was limited so it may
be full of holes:

Sub StrikeOut()
Dim oRng As Word.Range
Set oRng = Selection.Range
With oRng
.Collapse wdCollapseStart
.Expand wdWord
Do Until .End >= Selection.End
.Move wdWord, 4
.Expand wdWord
Do Until .Characters.First Like "[A-Za-z]" _
Or .End = Selection.End
.Move wdWord, 1
.Expand wdWord
Loop
If .Characters.Last = " " Then
.MoveEnd wdCharacter, -1
End If
.Font.StrikeThrough = True
Do
.Move wdWord, 1
Loop Until .Characters.First Like "[A-Za-z]" _
Or .End + 1 >= Selection.End
.Expand wdWord
Loop
End With
End Sub

 

[Helmut Weber]

Hi Greg,

I see, I've somehow managed to forget
to paste my code before posting,
which may have been a lucky incident.

Sub Test5554A()
Dim strChr As String
Dim RngWrd As Range
Dim RngTmp As Range
Dim lngCnt As Long
Set RngTmp = ActiveDocument.Paragraphs(1).Range
For Each RngWrd In RngTmp.Words
RngWrd.Select ' for testing remove later
strChr = RngWrd.Characters.Last
While IsCharacter(strChr) = False _
And RngWrd <> ""
RngWrd.End = RngWrd.End - 1
RngWrd.Select
strChr = RngWrd.Characters.Last
Wend
If RngWrd = "" Then lngCnt = lngCnt - 1
lngCnt = lngCnt + 1
If lngCnt = 5 Then
RngWrd.Font.StrikeThrough = True
lngCnt = 0
End If
Next
End Sub

Public Function IsCharacter(strTmp As String) As Boolean
Dim strAll As String
IsCharacter = False
strAll = "abcdefghijklmnopqrstuvwxyz"
If InStr(1, strAll, strTmp, vbTextCompare) > 0 Then
IsCharacter = True
End If
End Function

I like your code better!

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Greg Maxey]

Hi Helmut,

I wondered at the brevity of your previously posted solution ;-)

I thought about inquiring, but then thought you may still be
distraught over the Australian Open finals.

Cheers

 

[Mac1980]

I need a similar macro but want to highlight and bold every 5th word of every sentence. please post if you have it.

 

[Mac1980]

This worked with me. I wanted the same thing, but along with the bold, I want to highlight the word - Can anyone help me with this?