objWrdDoc.Bookmarks("Закладка1").Range.Text = Range("A1")
'Копируем из Excel диапазон "A1:A10" Range("A1:A10").Copy 'Вставляем в Word - в начало документа objWrdDoc.Range(0).Paste 'Если надо вставить в объект закладки ворда' objWrdDoc.Bookmarks("Закладка1").Range.Text = Range("A1")
'Здесь я копирую содержимое листаThisWorkbook.Worksheets("{лист1}").UsedRange.Copy 'А как заменить в шаблоне {лист1} на то что скопировали??
ThisWorkbook.Worksheets("{лист1}").UsedRange.Copy
.Find.Replacement.Text = "^c"
Sub Import_Word() Dim objWrdApp As Object, objWrdDoc As Object, wdRange As ObjectDim 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:\Users\Olef\Desktop\макрос\Шаблон.doc"'находится в папке с рабочей книгойSet objWrdDoc = objWrdApp.Documents.Open("C:\Users\Olef\Desktop\макрос\Шаблон.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 = "^c" .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