Strikethrough every nth word

G

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.
 
D

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
 
G

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
 
H

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"
 
L

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
 
L

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
 
C

clickmagundi

Hi,

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

It is great tool for plain language editing.
 
G

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
 
H

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"
 
G

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
 
Joined
Dec 14, 2020
Messages
2
Reaction score
0
I need a similar macro but want to highlight and bold every 5th word of every sentence. please post if you have it.
 
Joined
Dec 14, 2020
Messages
2
Reaction score
0
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?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top