Иногда бывает необходимо перенести что-то из Excel в другое приложение. Я возьму для примера Word. Например скопировать ячейки и вставить. Обычно мы это так и делаем - скопировали в Excel, открыли Word - вставили. Но сделать это при помощи кода чуть сложнее, хотя если разобраться никаких сложностей нет. Ниже приведен пример кода, который открывает Word, открывает в нем определенный документ, копирует данные из Excel и вставляет в открытый документ Word.
Sub OpenWord() Dim objWrdApp As Object, objWrdDoc As Object 'создаем новое приложение Word Set objWrdApp = CreateObject("Word.Application") 'Можно так же сделать приложение Word видимым. По умолчанию открывается в скрытом режиме 'objWrdApp.Visible = True 'открываем документ Word - документ "Doc1.doc" должен существовать Set objWrdDoc = objWrdApp.Documents.Open("C:\Doc1.doc") 'Копируем из Excel диапазон "A1:A10" Range("A1:A10").Copy 'вставляем скопированные ячейки в Word - в начала документа objWrdDoc.Range(0).Paste 'закрываем документ Word с сохранением objWrdDoc.Close True ' False - без сохранения 'закрываем приложение Word - обязательно! objWrdApp.Quit 'очищаем переменные Word - обязательно! Set objWrdDoc = Nothing: Set objWrdApp = Nothing End Sub |
Tips_Macro_OpenWord.xls (49,5 КиБ, 6 947 скачиваний)
В файле-примере, приложенном к данной статье, в комментариях к коду есть несколько добавлений. Например, как вставить текст из ячеек в определенные закладки Word-а и как добавить новый документ, а не открывать уже имеющийся. Так же так есть код проверки - открыто ли приложение Word в данный момент. Порой это тоже может пригодиться, чтобы работать с запущенным приложением Word, а не создавать новое:
Sub Check_OpenWord() Dim objWrdApp As Object On Error Resume Next 'пытаемся подключится к объекту Word Set objWrdApp = GetObject(, "Word.Application") If objWrdApp Is Nothing Then 'если приложение закрыто - создаем новый экземпляр Set objWrdApp = CreateObject("Word.Application") 'делаем приложение видимым. По умолчанию открывается в скрытом режиме objWrdApp.Visible = True Else 'приложение открыто - выдаем сообщение MsgBox "Приложение Word уже открыто", vbInformation, "Check_OpenWord" End If End Sub |
В принципе, активировать или вызвать(если закрыто) другое приложение Офиса можно одной строкой:
Sub Open_AnotherApp() Application.ActivateMicrosoftApp xlMicrosoftWord End Sub |
но данный метод может пригодиться только в том случае, если Вам необходимо действительно лишь активировать другое приложение, но дальше обращаться к этому приложению Вы уже не сможете.
По сути, методами
Для начала открываем меню
Подключаем библиотеку:
Затем объявляем переменную и присваиваем ей тип нужного приложения:
Sub OpenWord() Dim objWrdApp As Word.Application Set objWrdApp = New Word.Application objWrdApp.Visible = True End Sub |
Если теперь в редакторе, внутри этой процедуры в любом месте ниже объявления переменной набрать objWrdApp и точку, то сразу после ввода точки выпадет меню, в котором будут перечислены все доступные методы и свойства этого приложения.
Так же можно нажать
Метод установки ссылки на библиотеку приложения через Tools-References называют еще ранним связыванием. Подобный метод позволяет создать ссылку на приложение быстрее и, как описано выше, предоставляет разработчику доступ к визуальному отображению свойств и методов объекта. Но есть существенный минус: если в своем коде Вы установите ссылку на Word 12 Object Libbary(Word 2007), то на ПК с установленным Word 2003 получите ошибку MISSING, т.к. Word 2003 относится к библиотеке Word 11 Object Libbary. Подробнее можно прочитать в статье Ошибка — Cant find project or library.
Метод же CreateObject еще называется методом позднего связывания. Применяя его не возникнет проблем с MISSING, очень часто возникающих при раннем связывании. Поэтому я рекомендовал бы при разработке использовать раннее связывание для удобства использования свойств и методов(если Вы их не знаете), а перед распространением приложения в коде заменить все именованные константы(типа wdLine) на числовые константы(для wdLine это 5) и применить позднее связывание. Посмотреть числовое значение константы можно просто записав её в коде, начать выполнение кода через
ниже будет выведено числовое представление этой константы.
А заменять эти константы их числовыми значениями в случае с поздним связыванием необходимо, т.к. Excel не знает их значений.
Попробую пояснить поподробнее про эти константы и почему их надо заменять какими-то числами: при подключении библиотеки Wordа(Word 12 Object Libbary) мы так же подключаем и все свойства, методы и константы, которые доступны из Wordа. И их использование напрямую становится доступно из Excel и мы можем смело написать что-то вроде
И хочу так же упомянуть про ошибку, которую очень часто совершают при обращении к одному приложению из другого. Допустим, необходимо скопировать из Word все данные в Excel. Часто начинающие делают это так:
Sub OpenWord() Dim objWrdApp As Object, objWrdDoc As Object 'создаем новое приложение Word Set objWrdApp = CreateObject("Word.Application") 'Можно так же сделать приложение Word видимым. По умолчанию открывается в скрытом режиме 'objWrdApp.Visible = True 'открываем документ Word - документ "Doc1.doc" должен существовать Set objWrdDoc = objWrdApp.Documents.Open("C:\Doc1.doc") 'Копируем из Word все данные, обращаясь к объекту Range документа Range.Copy 'вставляем скопированное в ячейку А1 активного листа Excel ActiveSheet.Paste 'закрываем документ Word без сохранения objWrdDoc.Close False 'закрываем приложение Word objWrdApp.Quit 'очищаем переменные Word - обязательно! Set objWrdDoc = Nothing: Set objWrdApp = Nothing End Sub |
На строке Range.Copy обязательно получите ошибку от VBA, указывающую, что нужен аргумент для объекта. Можно попробовать добавить этот аргумент: Range(1).Copy. Но все равно получим ошибку. Можно, конечно, указать даже ячейки: Range("A1").Copy. Но это приведет к тому, что скопирована будет ячейка А1 активного листа Excel.
Все дело в том, что мы хотим скопировать данные из Word-а, выполняя при этом код из Excel. А у Excel тоже есть объект Range с другими аргументами. И если не указать какому приложению, листу или документу принадлежит Range, то по умолчанию он будет отнесен к тому приложению, из которого выполняется код. Т.е. к Excel. Если совсем кратко об этом - всегда надо указывать какому приложению или объекту принадлежит используемый объект или свойство. Правильно код должен выглядеть так:
Sub OpenWord() Dim objWrdApp As Object, objWrdDoc As Object 'создаем новое приложение Word Set objWrdApp = CreateObject("Word.Application") 'Можно так же сделать приложение Word видимым. По умолчанию открывается в скрытом режиме 'objWrdApp.Visible = True 'открываем документ Word - документ "Doc1.doc" должен существовать Set objWrdDoc = objWrdApp.Documents.Open("C:\Doc1.doc") 'Копируем из Word все данные, обращаясь к объекту Range документа 'при этом перед Range явно указываем откуда его брать - из документа Word -objWrdDoc("C:\Doc1.doc") objWrdDoc.Range.Copy 'вставляем скопированное из Word в активную ячейку активного листа Excel ActiveSheet.Paste 'закрываем документ Word без сохранения objWrdDoc.Close False 'закрываем приложение Word objWrdApp.Quit 'очищаем переменные Word - обязательно! Set objWrdDoc = Nothing: Set objWrdApp = Nothing End Sub |
Вместо Range ту же ошибку делают и с Selection(потому что Selection часто присутствует в записанных макрорекордером макросах), т.к. этот объект есть и в Excel и в Word и без явного указания приложения будет относится к приложению, в котором записано.
В приложенном файле код немного отличается от представленных выше - в нем можно посмотреть как вставить текст из ячеек в определенные(созданные заранее) закладки Word-а. Это удобно для создания бланков в Word и заполнения их через Excel
Tips_Macro_OpenWord.xls (49,5 КиБ, 6 947 скачиваний)
А в архиве ниже - практически готовое решение заполнения всевозможных бланков Word из Excel. Как это работает. У нас есть таблица Excel с данными для заполнения бланков заявлений на пособия:
Обращаю внимание, что в первой строке расположены метки. Они нужны для того, чтобы код мог понять значения какого столбца в какое место шаблона Word должны попасть. А в самом шаблоне Word мы должны проставить эти самые метки:
Фигурные скобки сделаны для того, чтобы код 100% искал и заменял только метку в шаблоне, исключая при этом замену случайного текста вне скобок(ведь слово "Должность" может встречаться и само по себе).
А здесь я схематично привел то, как будут происходить замены:
Сначала программа создаст новую папку, в которую и будет сохранять создаваемые файлы(имя папки состоит из даты и времени запуска кода). Далее программа циклом пройдется по каждой строке таблицы, создаст на основании шаблона Word(
'считываем фамилию с инициалами
sWDDocName = .Cells(lr, 1).Value |
'имя шаблона Word с основным текстом и метками Const sWDTmpl As String = "Шаблон.doc" |
В общем-то, если хоть чуть-чуть разбираетесь, то поменять можно многое. А для тех, кто не разбирается достаточно будет просто создавать метки в файле Word и обозначать ими столбца в таблице Excel. Количество столбцов и строк в таблице код определяет автоматически и при изменении размеров таблицы ничего изменять не надо. Главное, чтобы метки находились в первой строке, вторая строка - заголовок(необязательно), а с третьей строки начинаются данные, которые и используются для наполнения шаблонов.
Автосоздание бланков Word из таблицы Excel.zip (37,6 КиБ, 2 050 скачиваний)
Примеры работы с тем же Outlook можно посмотреть в моих статьях:
Как отправить письмо из Excel?
Сохранить вложения из Outlook в указанную папку
Мне нужно было из таблицы в excel составит письмо в word. В таблице сотни организации и каждому нужно отдельное письмо нужно написать и сохранить в wordе. Думаю мне это поможет. Благодарю автора!
Добрый день, Дмитрий!
Очень полезный пример заполнения, прямо то что искал. В принципе это полностью подходит для решения моих задач, однако хотелось бы оптимизировать код. В моем случае я не перебираю циклом строки для заполнения, а иду последовательно попутно проверяя значения из листа анкеты и планомерно заполняю шаблон. Поэтому хотелось ту часть макроса которая находит/заменяет значения в шаблоне сделать в виде функции и по мере необходимости просто подставлять значение для поиска и замены. Перенес эту часть в функцию:
Public Function Repl(sFindVal As String, sReplaceVal As String)
Dim objWrdApp As Object, objWrdDoc As Object, wdRange As Object
' Dim sFindVal As String, sReplaceVal As String
Set wdRange = objWrdDoc.Range
'çàìåíÿåì ìåòêè {*} íà òåêñò èç ÿ÷ååê
wdRange.Find.ClearFormatting
wdRange.Find.Replacement.ClearFormatting
With wdRange.Find
.Text = sFindVal
.Replacement.Text = sReplaceVal
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdRange.Find.Execute Replace:=2 'wdReplaceAll
End Function
а в макросе просто задаю значения и вызываю функцию
sFindVal = .Cells(2, 1).Value
sReplaceVal = .Cells(2, 3).Text
Call Repl(sFindVal, sReplaceVal)
В итоге макрос ошибок не выдает но и ничего не делает. Подскажите пожалуйста, на что обратить внимание, куда копать и возможно ли так сделать?
Alex23, как минимум обратить внимание на то, что в моем коде переменным objWrdApp и objWrdDoc задаются значения: приложение Word и документ соответственно. В Вашей функции они просто объявлены внутри самой функции, но никаких значений им не присваивается. Следовательно они равны Nothing. Возможно, назначение идет в родительской процедуре - но тогда надо и их передавать в качестве аргументов, а не объявлять новые переменные внутри функции.
А ошибок не получаете потому что где-то в родительской процедуре есть строка On Error Resume Next.
Спасибо большое за помощь, функция заработа благодаря Вашим подсказкам:
Public Function Repl(sFindVal As String, sReplaceVal As String, wdRange As Object)
'çàìåíÿåì ìåòêè {*} íà òåêñò èç ÿ÷ååê
wdRange.Find.ClearFormatting
wdRange.Find.Replacement.ClearFormatting
With wdRange.Find
.Text = sFindVal
.Replacement.Text = sReplaceVal
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdRange.Find.Execute Replace:=2 'wdReplaceAll
Думал ну все, теперь все легко, однако столкнулся со следующей проблемой. Кодом собираю с листа достаточно большой кусок для замены, однако не срабатывает
Dim PorType, PorPreambula As String
PorType = .Cells(18, 3).Value
тут Select и далее
Case Is = "ИП"
PorPreambula = .Cells(17, 3).Value & ", действующий на основании " & .Cells(24, 3).Value & ", номер ОГРНИП " _
& .Cells(35, 3).Value & ", (паспорт гражданина РФ серия " (ДО ЭТОГО МОМЕНТА РАБОТАЕТ, А ПОСЛЕ НИЧЕГО НЕ МЕНЯЕТ) & .Cells(27, 3).Value & " № " & .Cells(28, 3).Value _
& ", выданный " & .Cells(29, 3).Value & ", " & .Cells(30, 3).Value & " г., код подразделения " & .Cells(31, 3).Value _
& ", СНИЛС " & .Cells(33, 3).Value & ", ИНН " & .Cells(34, 3).Value & "), именуемый в дальнейшем Поручитель"
sFindVal = "{Поруч_преамб}"
sReplaceVal = PorPreambula
Call Repl(sFindVal, sReplaceVal, objWrdDoc.Range)
Причем дело не в ячейке 27-3, пробовал просто добавлять текст, тоже в итоге ничего не заменяет. Вроде переменная String позволяет хранить достаточно много символов... не могу понять в чем затык
Попробовал вручную присвоить переменной PorPreambula рандомный текст (абзац строк на 7) - тот же результат. Такое впечатление что если переменная длиннее какого-то количества символов то происходит ошибка и функция просто не срабатывает
Из VBA есть ограничение: значение для поиска и для замены не должно превышать 255 символов. Поэтому для корректной работы с длинными текстами надо изобретать обходные пути.
Спасибо за оперативный ответ, буду что-нибудь придумывать.
Дмитрий Приветствую.
Немного изменил ваш макрос. Но не могу понять как сделать так, чтобы метка в шаблоне заменилась таблицей с листа рабочей книги.
Вот вариант моего кода:
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
Дмитрий, приветствую!
Помогите с небольшим нюансом. У вас в коде есть такой момент:
'Копируем из Excel диапазон "A1:A10"
Range("A1:A10").Copy
'Вставляем в Word - в начало документа
objWrdDoc.Range(0).Paste
'Если надо вставить в объект закладки ворда
' objWrdDoc.Bookmarks("Закладка1").Range.Text = Range("A1")
Я пытаюсь адаптировать под себя и мне нужно чтобы метка в шаблоне {лист1} менялась на таблицу с листа {лист1}
'Здесь я копирую содержимое листа
ThisWorkbook.Worksheets("{лист1}").UsedRange.Copy
'А как заменить в шаблоне {лист1} на то что скопировали??
???????? Подскажите пожалуйста!
Евгений(или Николай) :) Если брать за основу макрос по замене по меткам, то после
ThisWorkbook.Worksheets("{лист1}").UsedRange.Copy
надо в коде замены Word записать вместо конкретного значения вставку из буфера обмена:
.Find.Replacement.Text = "^c"
Дмитрий, добрый день! Подскажите, пожалуйста, какой код нужен для того, чтобы в закладки шаблона Ворд передавались ячейки одного определённого столбца, именованного определенной датой? Попробую пояснить: есть таблица из 12 строк с определенными показателями которые необходимо передать в Ворд, столбцы - даты отчетов.
Добрый день. Без примера данных сложно предоставить код. Если надо найти столбец с определенной датой - элементарный цикл по строке с заголовком:
Останется только использовать этот столбец для заполнения, видимо.
Дмитрий, есть файлы с примерами, а как их вложить?
Отправил почтой.
Oleg1004, и что предлагаете сделать с файлами? :) Написать под них с нуля коды? Вы выслали файлы без единой строки кода и без единой попытки решить свою проблему самостоятельно. При подобном подходе это уже не помощь - это решение за Вас Вашей проблемы, а у меня нет времени на подобные вещи, у меня своя работа есть.обратитесь в форум (там можно и файлы прикладывать).
Постарайтесь адаптировать код под себя - основной код и направление решения по поиску столбца есть, осталось дело за малым.
не получится самостоятельно -
Дмитрий, я не программист от слова "совсем". Да, мне необходимо решение этой задачи, и понимая, что любая работа оплачивается - назовите цену.