[решено] Необходим макрос.Как выделить все слова написанные загалавными буквами в документе?

[wiznv]

Есть текст где название глав написаны зАглавными буквами.Задача состоит в тот что нужно выделить эти слова и сделать шрифт полужирным.
Уверен что нужен макрос т.к. стандартными средствами замены ничего не получается.

[Delirium]

Set myRange = ActiveDocument
For Each aword In myRange.Words
If aword.Text = UCase(aword.Text) And RTrim(aword.Text) <> "" Then
aword.Bold = True
' MsgBox aword.Text
End If
Next aword

[wiznv]

Спасибо Delirium! Все так как нужно ,почти....Макрос выделеят всЕ заглавные буквы включае предлоги :( ,а нужно только СЛОВА . т.е. те где больше одной буквы...

[Delirium]

Set myRange = ActiveDocument
For Each aword In myRange.Words
If aword.Text = UCase(aword.Text) And RTrim(aword.Text) <> "" Then
If Len(aword.Text) > 1 Then
aword.Bold = True
' MsgBox aword.Text
End If
End If
Next aword

[Delirium]

Кстати, решение было найдено во встроенной справке :) Главное было - найти функцию, считающую слова в документе. Дальше - дело техники и условий :)

[wiznv]

Delirium спасибо огромное!давай добъем этот макрос. Я тут начал коече вспоминать с универа...но как видишь плохо... :help:
Т.к. последний вариант макроса числа тоже жирными делает,то нужно сравнить строку с числом.Т.е. если это НЕ число то aword.Bold = True

Так вот,я подумал что aword.text надо сравнить с числом так: объявить переменную типа integer потом ее сравнить с aword.text...короче сильно не бить)) вот код:

Sub makros()
Dim Chislo As Integer
Set myRange = ActiveDocument
For Each aword In myRange.Words
If aword.Text = UCase(aword.Text) And RTrim(aword.Text) <> "" Then
If Len(aword.Text) > 3 Then
If aword.Text <> Chislo Then
aword.Bold = True
End If
End If
Next aword

End Sub

Но увы.с ошибкой работает макрос...незнаю как исправить..

[Delirium]

If IsNumeric(aword.Text) = True Then

и после aword.Bold = True
End If Не забудь

[wiznv]

еще бы проверить вариант где он слова начинающиеся с новой строки толко выделял или после цифры...но это уже слишком сложно и не обязательно! Спасибо добрый человек!
Итого:
Sub makros()
Set myRange = ActiveDocument
For Each aword In myRange.Words
If aword.Text = UCase(aword.Text) And RTrim(aword.Text) <> "" Then
If Len(aword.Text) > 2 Then
IIf IsNumeric(aword.Text) = falsh Then
aword.Bold = True
End If
End If
End If
Next aword

End Sub

[Delirium]

wiznv, обрамляйте свой код тегами [CODE] - решетка на панели. Тогда будет гораздо наглядней.