Страница 2 из 5
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 09 май 2014, 13:56
Михаил_П
pashulka писал(а):Если речь идёт о Microsoft Office XP (или старше), то можно воспользоваться этим
советом и замутить, что-то вроде :
Код: Выделить всё
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
iPath = .SelectedItems(1)
iPath = IIf(Right(iPath, 1) = "\", iPath, iPath & "\")
Else
MsgBox "Выберите нужную папку", vbCritical, ""
Exit Sub
End If
End With
Интересно, но почему-то макрос не исправляет всё содержимое колонтитулов. Что-то поправляет, что-то оставляет как есть))) Загадка...
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 30 май 2015, 18:19
vans
Друзья, добрый день. У меня такая же задача как и у автора. Можно ли объеснить как это использвать? Если можно как для тупых.
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 30 май 2015, 20:34
pashulka
1) Скачайте пример из поста #6
2) Составьте свой список автозамены
3) В макросе укажите свою папку
4) В макросе укажите расширение файлов (сейчас там только .doc) если есть шанс, что в папке могут наличествовать документы различных версий, например и .docx, то "замените" "*.doc" на "*.doc*"
5) Кликните кнопку Замена в файлах .doc
P.S. Повторюсь, но тестировать лучше на копиях документах, ибо отката(отмены действий макроса) уже не будет.
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 02 мар 2016, 15:13
KapitanFracas
Здравствуйте скачал пример. Спасибо автору.
Подскажите пожалуйста почему при попытке запуска макроса:
Private Sub Test()
Dim iPath$, iFileName$, iText$
Dim iCount&, iCounter&, iArrText As Variant
Dim iWordApp As Object, iWordDoc As Object
iPath = "C:\Users\pc\Desktop\CHINESE TRANSLATIONS"
iFileName = Dir(iPath & "*.doc*")
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
'iWordApp.DisplayAlerts = 0 'wdAlertsNone
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
Else
MsgBox "files with extension .doc not found", vbCritical, ""
End If
.............................................................
макрос сразу перескакивает в предупреждение
Else
MsgBox "files with extension .doc not found", vbCritical, ""
End If
то есть не находит ни одного файла с расширением "*.doc*"?
Спасибо
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 02 мар 2016, 20:11
pashulka
Не было в моём примере предупреждения на буржуйском языке
Зато было написано, цитирую
Код: Выделить всё
iPath = "C:\Test\" 'укажите свою папку с завершающим слэшем
А где у Вас слэш после CHINESE TRANSLATIONS ?
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 04 мар 2016, 16:01
KapitanFracas
спасибо большое, если смогу запустить с меня бутыль буржуйского

Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 04 мар 2016, 16:32
KapitanFracas
нет не удалось
................
Private Sub Test()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
iPath = .SelectedItems(1)
iPath = IIf(Right(iPath, 1) = "\", iPath, iPath & "\")
Else
MsgBox "§£§í§Ò§Ö§â§Ú§ä§Ö §ß§å§Ø§ß§å§ð §á§Ñ§á§Ü§å", vbCritical, ""
Exit Sub
End If
End With
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
'iWordApp.DisplayAlerts = 0 'wdAlertsNone
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
Else
MsgBox "files with extension .doc not found", vbCritical, ""
End If
End Sub
.................
Выбор фолдера запускается, выбираю фолдер, сразу идет сообщение что файл не найден.
Пашулька а может оставите способ связи? договоримся.
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 04 мар 2016, 19:43
pashulka
Достаточно просто добавить слэш, т.е.
Код: Выделить всё
iPath = "C:\Users\pc\Desktop\CHINESE TRANSLATIONS\"
Если же нужен диалог выбора папки, то не нужно выкидывать из авторской версии важные моменты. Проще говоря, должно быть так :
Код: Выделить всё
End With
iFileName = Dir(iPath & "*.doc*")
If iFileName <> "" Then
И не стоит забывать, что в этом примере функция Dir будет игнорировать файлы с атрибутами Скрытый и/или Только для чтения. Если же это неприемлемо, то
здесь в Example2 есть решение.
Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 10 мар 2016, 14:12
KapitanFracas
Спасибо, сделал, теперь диалог открывается но выдается ошибка 5151
Pashulka a давайте еще упростим задачу? Исходник был написан для множественных файлов в выбранной папке. Но мне нужен один файл, не подскажете какой диалог лучше для выбора одного файла? Я диалог отлажу отдельно а потом перейдем к замене. Спасиб

Re: Макрос для для замены слов в файле word из файла-словаря Excel
Добавлено: 10 мар 2016, 18:42
pashulka
Один из возможных вариантов :
Код: Выделить всё
Dim iFileName As Variant
iFileName = Application.GetOpenFilename("Word Files (*.doc*), *.doc*")
If iFileName <> False Then
MsgBox iFileName, , ""
Else
MsgBox "Надо было выбрать документ", vbCritical, ""
End If