Set the next word in capital letters in Arial Black font

[gloub]

Hello,
I am new to this forum.


I'm trying to write a macro that changes the font of the next word written in capital letters (set them in Arial Black).

I know how to skip to the next word
Selection.MoveRight Unit:=wdWord, Count:=1

And, after searching the internet for a while, I've understood that I could use this method :

If UCase(MyText) = MyText Then ..
I've also read that, to have this work, it should come after this code :
Option Compare Binary
....but I know too little about VBA to write the whole macro.

Could anyone help me do this, please ?

Many thanks.

[gmayor]

The problem with such a macro is in determining where the next 'word' starts and ends as Word does not necessarily interpret what is a 'word' as may you. The following should work in most circumstances.

Sub FormatNextWord()'Graham Mayor - https://www.gmayor.com - Last updated - 02 Dec 2019
Dim strList As String
Dim orng As Range
strList = Chr(9) & Chr(11) & Chr(13) & Chr(32) & Chr(33) & Chr(34) & _
Chr(39) & Chr(41) & Chr(44) & Chr(46) & Chr(58) & Chr(59) & Chr(63)
Set orng = Selection.Words.Last
With orng
.MoveEndWhile strList
.Collapse 0
.MoveEndUntil strList
.Font.AllCaps = True
.Font.Name = "Arial Black"
End With
lbl_Exit:
Set orng = Nothing
Exit Sub
End Sub

[gloub]

Thank you !
But while using your code, I realized that, due to the fact that I'm not fluent in english, the way I asked my question was misleading (sorry about that).
To put it more clearly :
– what your code does : find the next word >>> turn it into capital letters in Arial Black Font
– what I'd like it to do : find the next word in capital letters >>> turn it into Arial Black Font
I hope it's feasible.

[gmayor]

How about

Sub Macro1()
Dim oRng As Range
Dim i As Long
Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
For i = 2 To oRng.Words.Count
If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
oRng.Words(i).Font.Name = "Arial Black"
Exit For
End If
Next i
Set oRng = Nothing
End Sub

[gloub]

Thanks, it's fantastic !

........although I need a little "improvement" : I need to be able to change the font of words in capital letters one after the other, but with your code, the insertion point remains unchanged after the macro is executed.
So I've tried to change your code to make Word skip to the next word.

Dim oRng As RangeDim i As Long
Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
For i = 2 To oRng.Words.Count
If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
oRng.Words(i).Font.Name = "Arial Black"

Application.Selection.Words(1).Select
Selection.MoveRight Unit:=wdWord, Count:=1


Exit For
End If
Next i
Set oRng = Nothing
But it does not work : Word goes back to the insertion point that was set before the macro was launched.
Could you please help me solve this (this should be the last time) ?
Thanks !

[gmayor]

Remove the line
Exit For from my macro and it will apply the font to all capitalised Words to the end of the document.

If you prefer to do them one at a time, then set the selection to the end of the word you have just processed e.g.


Sub Macro1()
Dim oRng As Range
Dim i As Long
Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
For i = 2 To oRng.Words.Count
If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
oRng.Words(i).Font.Name = "Arial Black"
oRng.Start = oRng.Words(i).End
oRng.Collapse 1
oRng.Select
Exit For
End If
Next i
Set oRng = Nothing
End Sub

However if you want to format them all, replace is much faster


Sub Macro2()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Replacement.Font.Name = "Arial Black"
.Execute findText:="[ABCDEFGHIJKLMNOPQRSTUVWXYZ]{2,}", _
MatchWildcards:=True, _
Replace:=wdReplaceAll
End With
Set oRng = Nothing
End Sub

[gloub]

Thank you SOOOOO MUCH !
I appreciate.
And thanks for explaining in detail.
:clap::clap::clap::clap::clap::clap: