Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 11 мар 2016, 14:48
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
Подозреваю что в сабе осталось что то связанное с множественными файлами но не могу понять в которой строке
открывает диалог, я нахожу вордовский файл, выходит сообщение с именем выбранного файла,
...и зависает навечно, естественно в ворде ниче не заменяется. Прерываю, выдается сообщение об ошибке 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
Подозреваю что в сабе осталось что то связанное с множественными файлами но не могу понять в которой строке
