Макрос для для замены слов в файле word из файла-словаря Excel

[Aslin]

Спасибо, все работает на отлично. А скажите пожалуйста, как составить команду и куда ее вставить, что замененные слова выделялись цветом?
И еще не посоветуете какие-нибудь учебники, чтобы научиться в совершенстве самой писать коды?

[pashulka]

В сети предлагают такой вариант выделения цветом :

Код: Выделить всё

Public Sub Test()
 
Dim iFileName$, iCount&, iArr As Variant
Dim wb As Object, ws As Object
 
iFileName = ActiveDocument.Path & "\Словарь1з.xls"
 
Set wb = GetObject(iFileName)
Set ws = wb.Worksheets("Лист1")
 
iArr = ws.Cells(1).CurrentRegion.Value
 
Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdYellow
 
With ActiveDocument.Content.Find
     .Replacement.Highlight = True
     For iCount = 1 To UBound(iArr)
         .Execute iArr(iCount, 1), , , , , , , , , iArr(iCount, 2), wdReplaceAll
     Next
End With
 
Application.ScreenUpdating = True
 
wb.Close False
 
End Sub

Насчёт литературы не подскажу, но уверен, что в сети можно найти ответ и на этот вопрос.

[Aslin]

Здравствуйте, данный макрос работает хорошо, но есть одно "НО". Можно ли как-то сделать чтобы искал именно целиком слово, а не его часть. То есть у меня есть замена "но" на "однако" и во всех словах где есть это словосочетание он заменяет его на "однако". Например, слово правоспособность поменялось на правоспосободнакость. Как это исправить?

[Aslin]

И еще один вопрос, заметила, что не все слова он заменяет на синонимы...... не смотря на то, что они есть в словаре

[pashulka]

1) Используйте опцию Только слово целиком, т.е.

Код: Выделить всё

Public Sub Test()
 
Dim iFileName$, iCount&, iArr As Variant
Dim wb As Object, ws As Object
 
iFileName = ActiveDocument.Path & "\Словарь1з.xls"
 
Set wb = GetObject(iFileName)
Set ws = wb.Worksheets("Лист1")
 
iArr = ws.Cells(1).CurrentRegion.Value
 
Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdYellow
 
With ActiveDocument.Content.Find
     .Replacement.Highlight = True
     For iCount = 1 To UBound(iArr)
         .Execute Trim(iArr(iCount, 1)), , True, , , , , , , Trim(iArr(iCount, 2)), wdReplaceAll
     Next
End With
 
Application.ScreenUpdating = True
 
wb.Close False
 
End Sub

[pashulka]

2) Тому может быть несколько причин :

- в конце\начале слова, которое подлежит замене, наличествует один(или более) пробел(ов). для борьбы с этим безобразием используйте VB(A) функцию Trm (см. код из предыдущего сообщения)
- в словаре, между словами, наличествует пустая строка. в этом случае currentregion просто отбросит всё, что находится после первой пустой строки. бороться с этим можно, либо не создавая пустых строк, либо отказавшись от использования текущей области (см. самые первые примеры топика)
- возможно также, что этих слов просто нет, например, они либо в словаре, либо в тексте набраны с "незаметными" ошибками. или, что хуже, при их написании была использована не только кириллица, но и латиница, типа cлово (здесь c это eng)

Если Вы уверены, что все три варианта мимо, то опять нужны примеры, doc и xls

[Aslin]

Проверила по пунктам, все у меня в порядке, без пробелов и т.д.
Кстати, сделал прокрутку при помощи отмены действия, оказывается, он некоторые слова два раза заменяет синонимами. Я думала, что он дойдет до конца текста и остановится

[pashulka]

Нет информации о том какие слова не были заменены.

[Aslin]

не были заменены предусмотренных, иных

[pashulka]

вместо слова предусмотренных написано , предусмотенных (A134)
слово иных (A60) меняется на прочих (B60) а затем Вы опять заставляете макрос менять всё обратно, т.е. прочих (A140) на иных (B140)