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

[KapitanFracas]

Tak. Все идет по плану

открывает диалог, я нахожу вордовский файл, выходит сообщение с именем выбранного файла,

...и зависает навечно, естественно в ворде ниче не заменяется. Прерываю, выдается сообщение об ошибке Run-time error 4198.

Целиком саб такой:


Private Sub Test()


Dim iFileName As Variant
iFileName = Application.GetOpenFilename("Word Files (*.doc*), *.doc*")

If iFileName <> False Then
MsgBox iFileName, , ""
Else
MsgBox "Select file", vbCritical, ""
End If
If iFileName <> "" Then
With Range(Cells(2, "A"), Cells(Rows.Count, "B").End(xlUp))
iArrText = .Value: iCount = UBound(iArrText)
End With

Set iWordApp = CreateObject("Word.Application")
iWordApp.Visible = False


Do
Set iWordDoc = iWordApp.Documents.Open(iPath & iFileName)

With iWordDoc.Content.Find
For iCounter = 1 To iCount
.Execute FindText:=iArrText(iCounter, 1), _
ReplaceWith:=iArrText(iCounter, 2), Replace:=2 'wdReplaceAll
Next
End With

iFileName = Dir: iWordDoc.Close -1 'wdSaveChanges
Loop Until iFileName = ""

iWordApp.Quit

End If

End Sub


Подозреваю что в сабе осталось что то связанное с множественными файлами но не могу понять в которой строке

[pashulka]

KapitanFracas, Если и дальше будут сыпаться ошибки, связанные с автоматизацией, то Вам нужно будет обратить своё внимание именно на них ...

[KapitanFracas]

да супер, работает. жаль что наложились другие проблемы. спасибо огромное

[pashulka]

Если другие проблемы, связаны конкретно с заменой, то тему можно продолжить ...

[Aslin]

Здравствуйте, может кто-нибудь помочь с написанием макроса. У меня есть готовый макрос с интернета для замены слов синонимами из тезерауса ворда, а мне бы хотелось, чтобы он находил слова и словосочетания и заменял синонимами из созданного мною словаря (можно в эксель). Пыталась разобраться у вас в форуме, но не до конца поняла, работает ли ваш макрос или нет. Попробовала его в ворде. Не работает(.
Всем заранее спасибо, если поможете.

[pashulka]

Насчёт словосочетаний не знаю, но если выложите небольшой фрагмент документа (.doc) и Вашего собственного словаря (.xls), то, возможно, ответ и найдётся.

[Aslin]

Здравствуйте, не получается загрузить, пишет мол слишком большой, не подскажите как быть?

[pashulka]

Не нужно загружать весь документ и книгу, достаточно нескольких страниц текста и нескольких строк в книге. Если и этого будет много, то можно за архивировать (.rar, .zip и т.п.) и выложить уже архив.

[Aslin]

Спасибо, все получилось загрузить. [ATTACH]2453[/ATTACH]

[pashulka]

Aslin, Макрос для активного word документа, словарь должен располагаться в той же папке, что и документ. Разумеется, тестировать нужно на копии, не забыв, перед этим, указать реальное имя книги - словаря (включая расширение) и имя листа, где находится словарь.

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

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: iCount = UBound(iArr)

Application.ScreenUpdating = False

With ActiveDocument.Content.Find
     For iCount = 1 To iCount
         .Execute iArr(iCount, 1), , , , , , , , , iArr(iCount, 2), wdReplaceAll
     Next
End With

Application.ScreenUpdating = True

wb.Close False

End Sub