Суть адаптации: - Есть вордовский документ "Шаблон.doc" в котором стоят в нужных местах метки в фигурных скобках {Метка1} {Яч1} {Лист1}. - В рабочей книге метками являются имена ячеек (без каких либо скобок) и имена листов (также в фигурных скобках). - Макрос производит замену меток в шаблоне и сохраняет документ под другим именем. Причем метку, которая соответствует наименованию листа рабочей книги макрос должен заменить таблицей с этого листа.
Суть проблемы: - Не пойму как заменить метку в ворде скопированным диапазоном с листа ((
Код с описанием. Проблемный участок между пробелами. Подскажите юному дилетанту пожалуйста.
Скрытый текст
Код
Sub Import_Word()
Dim objWrdApp As Object, objWrdDoc As Object, wdRange As Object
Dim IsAppClose As Boolean
Application.ScreenUpdating = True
'пытаемся подключится к Word
On Error Resume Next
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
'если приложение закрыто - создаем новый экземпляр
Set objWrdApp = CreateObject("Word.Application")
'сделать видимым
objWrdApp.Visible = True
IsAppClose = True 'Не знаю что это
End If
On Error GoTo 0
If objWrdApp Is Nothing Then
MsgBox "Не удалось подключиться к Word"
Application.ScreenUpdating = True
Exit Sub
End If
'Открываем документ Word - документ "C:\макрос\Шаблон.doc"
'находится в папке с рабочей книгой
Set objWrdDoc = objWrdApp.Documents.Open("C:\макрос\Шаблон.doc")
'сохраняем файл шаблона с как "Расчет+дата.doc"
objWrdDoc.SaveAs ThisWorkbook.Path & "\Расчет " & Format(Now, "dd-mm-yy hh-mm") & ".doc"
'Перебираем именованые ячейки книги и сравниваем с метками в шаблоне, производим замену,
'если есть совпадения.
'Например. Значение ячейки с именем "Яч1" заменит метку в шаблоне {Яч1} по всему документу
Dim nName As Name
For Each nName In ThisWorkbook.Names
Set wdRange = objWrdDoc.Range
wdRange.Find.ClearFormatting
wdRange.Find.Replacement.ClearFormatting
With wdRange.Find
.text = "{" & nName.Name & "}"
.Replacement.text = Range(nName).text
.Forward = True
.Wrap = 1 'wdFindContinue - не знаю что это
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll - почемуто воспринимается как переменная и не работает :(
End With
Next nName
'Аналогичный перебор с листами книги. Таблица из листа {Лист1} должна заменить метку в шаблоне {Лист1}
Dim List As Worksheet
For Each List In ThisWorkbook.Worksheets
'Чтобы в переборе участвовали только листы с фигурными скобками
If InStr(List.Name, "{") > 0 Then
'Скопировали содержание листа
ThisWorkbook.Worksheets(List.Name).UsedRange.Copy
'Поиск и замена
With wdRange.Find
.text = List.Name
.Replacement.text = Selection.Paste ' Что то делаю не так :(((
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll
End With
End If
Next List
'закрываем документ Word с сохранением
objWrdDoc.Close True
'закрываем приложение Word - обязательно!
objWrdApp.Quit
'очищаем переменные Word - обязательно!
Set objWrdDoc = Nothing: Set objWrdApp = Nothing
End Sub
AlterEgo, вы используете глаголы мужского рода (попытался, поправил), но в профиле стоит женский пол. Аватар — скорее женский. Имеет смысл у вас уточнять пол или это будет для вас неприемлемо?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
, то для меня вы будете "оно" — мне просто так проще, чем каждый угадывать, кто зашёл — оно мне не нужно
P.S.: пошло-поехало
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
не по прямому профилю сайта всё же. Есть тут и по ворду спецы, но лучше всё же на других ресурсах посмотреть. Например, на Кибере есть модератор(-ка) shanemac51 — она точно подскажет. Это её профиль и у неё огромный опыт. Только не пишите ей в личку, а создайте тему в соответствующем разделе — она, скорее всего, сама заглянет. Лучше ещё указать, что есть кросс на Планете. И/или погуглите "слияние Word и Excel" — это запрос по вашей проблеме.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Не пойму в чём загвоздка. Вроде несложный ведь макрос. Писал когда-то для раздела Работа. Только там через закладки наладил. Или нужно именно через "Метки"?
написал: Мне кажется тема достойна основной ветки. Приложите пару файлов (Word и Excel)
Sanja, Да если решить этот момент, будет отличный макрос импорта в ворд и таблиц и значений, многие его ищут. Идея подсмотрена у РОБАСТИКА - надстройка. За основу взят макрос Щербакова.
в архиве папка, которая содержит шаблон и рабочую книгу для примера в коде прописан путь C:\макрос\Шаблон.doc