Иногда бывает необходимо перенести что-то из 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 836 скачиваний)


В файле-примере, приложенном к данной статье, в комментариях к коду есть несколько добавлений. Например, как вставить текст из ячеек в определенные закладки 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

но данный метод может пригодиться только в том случае, если Вам необходимо действительно лишь активировать другое приложение, но дальше обращаться к этому приложению Вы уже не сможете.

По сути, методами CreateObject и GetObject можно обратиться к любому стороннему приложению(например Internet Explorer). Куда важнее при обращении к этим объектам знать объектную модель того приложения, к которому обращаетесь. Чтобы увидеть свойства и методы объектной модели приложения, можно в редакторе VBA подключить необходимую библиотеку, объявить переменную, назначив ей тип приложения. Покажу на примере того же Word-а.
Для начала открываем меню Tools -References:

Подключаем библиотеку:

Затем объявляем переменную и присваиваем ей тип нужного приложения:

Sub OpenWord()
    Dim objWrdApp As Word.Application
    Set objWrdApp = New Word.Application
    objWrdApp.Visible = True
End Sub

Если теперь в редакторе, внутри этой процедуры в любом месте ниже объявления переменной набрать objWrdApp и точку, то сразу после ввода точки выпадет меню, в котором будут перечислены все доступные методы и свойства этого приложения.

Так же можно нажать F2 и через поиск найти Word и просмотреть все методы и свойства данного приложения.

Метод установки ссылки на библиотеку приложения через 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) и применить позднее связывание. Посмотреть числовое значение константы можно просто записав её в коде, начать выполнение кода через F8 и навести курсор мыши на эту константу. Всплывающая подсказка покажет числовое значение. Так же можно отобразить окно Immediate(View -Immediate Window или сочетание клавиш Ctrl+G), записать вопросительный знак и вставить эту константу и нажать Enter:
?wdLine
ниже будет выведено числовое представление этой константы.
А заменять эти константы их числовыми значениями в случае с поздним связыванием необходимо, т.к. Excel не знает их значений.
Попробую пояснить поподробнее про эти константы и почему их надо заменять какими-то числами: при подключении библиотеки Wordа(Word 12 Object Libbary) мы так же подключаем и все свойства, методы и константы, которые доступны из Wordа. И их использование напрямую становится доступно из Excel и мы можем смело написать что-то вроде wbLine и Excel поймет эту константу. При позднем же связывании мы уже не подключаем библиотеки Word(во избежание ошибок совместимости) и как следствие - методы, свойства и константы Wordа для Excel становятся чем-то неизвестным и не документированным и мы получим ошибку "Variable not defined"(если включена директива Option Explicit) при попытке назначить свойство через wdLine. Если же Option Explicit не включена - то хоть ошибки не будет, но и код будет работать неверно, т.к. для неизвестной для Excel переменной wbLine будет назначено значение 0(Empty). Поэтому и надо все константы другого приложения заменять их числовыми значениями.

Главная ошибка новичка
И хочу так же упомянуть про ошибку, которую очень часто совершают при обращении к одному приложению из другого. Допустим, необходимо скопировать из 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 836 скачиваний)


А в архиве ниже - практически готовое решение заполнения всевозможных бланков Word из Excel. Как это работает. У нас есть таблица Excel с данными для заполнения бланков заявлений на пособия:
Исходная таблица
Обращаю внимание, что в первой строке расположены метки. Они нужны для того, чтобы код мог понять значения какого столбца в какое место шаблона Word должны попасть. А в самом шаблоне Word мы должны проставить эти самые метки:
Шаблон Word с метками
Фигурные скобки сделаны для того, чтобы код 100% искал и заменял только метку в шаблоне, исключая при этом замену случайного текста вне скобок(ведь слово "Должность" может встречаться и само по себе).
А здесь я схематично привел то, как будут происходить замены:
Схема замен
Сначала программа создаст новую папку, в которую и будет сохранять создаваемые файлы(имя папки состоит из даты и времени запуска кода). Далее программа циклом пройдется по каждой строке таблицы, создаст на основании шаблона Word("Шаблон.doc") новый файл для этой строки, заполнит этот шаблона данными на основании меток, и сохранит созданный файл под новым именем. Сам файл шаблона при этом не изменяется - все метки в нем сохраняются как были настроены до запуска кода. Конкретно в приложенном коде значение для имени нового файла берется из первого столбца "ФИО с инициалами". Но это можно изменить в коде при необходимости. Делается это в этой строке:

'считываем фамилию с инициалами
sWDDocName = .Cells(lr, 1).Value

Что еще важно: файл шаблона Word должен находиться в той же папке, что и файл с кодом. Название файла в приложенном к статье файле должно быть "Шаблон.doc". Но его так же можно изменить, не забыв изменив его в коде в этой строке:

'имя шаблона Word с основным текстом и метками
Const sWDTmpl As String = "Шаблон.doc"

В общем-то, если хоть чуть-чуть разбираетесь, то поменять можно многое. А для тех, кто не разбирается достаточно будет просто создавать метки в файле Word и обозначать ими столбца в таблице Excel. Количество столбцов и строк в таблице код определяет автоматически и при изменении размеров таблицы ничего изменять не надо. Главное, чтобы метки находились в первой строке, вторая строка - заголовок(необязательно), а с третьей строки начинаются данные, которые и используются для наполнения шаблонов.
Скачать пример:

  Автосоздание бланков Word из таблицы Excel.zip (37,6 КиБ, 1 969 скачиваний)

Примеры работы с тем же Outlook можно посмотреть в моих статьях:
Как отправить письмо из Excel?
Сохранить вложения из Outlook в указанную папку

65 комментариев

  1. Мне нужно было из таблицы в excel составит письмо в word. В таблице сотни организации и каждому нужно отдельное письмо нужно написать и сохранить в wordе. Думаю мне это поможет. Благодарю автора!

  2. Добрый день, Дмитрий!
    Очень полезный пример заполнения, прямо то что искал. В принципе это полностью подходит для решения моих задач, однако хотелось бы оптимизировать код. В моем случае я не перебираю циклом строки для заполнения, а иду последовательно попутно проверяя значения из листа анкеты и планомерно заполняю шаблон. Поэтому хотелось ту часть макроса которая находит/заменяет значения в шаблоне сделать в виде функции и по мере необходимости просто подставлять значение для поиска и замены. Перенес эту часть в функцию:
    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)

    В итоге макрос ошибок не выдает но и ничего не делает. Подскажите пожалуйста, на что обратить внимание, куда копать и возможно ли так сделать?

    1. Alex23, как минимум обратить внимание на то, что в моем коде переменным objWrdApp и objWrdDoc задаются значения: приложение Word и документ соответственно. В Вашей функции они просто объявлены внутри самой функции, но никаких значений им не присваивается. Следовательно они равны Nothing. Возможно, назначение идет в родительской процедуре - но тогда надо и их передавать в качестве аргументов, а не объявлять новые переменные внутри функции.
      А ошибок не получаете потому что где-то в родительской процедуре есть строка On Error Resume Next.

      1. Спасибо большое за помощь, функция заработа благодаря Вашим подсказкам:
        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 позволяет хранить достаточно много символов... не могу понять в чем затык

        1. Попробовал вручную присвоить переменной PorPreambula рандомный текст (абзац строк на 7) - тот же результат. Такое впечатление что если переменная длиннее какого-то количества символов то происходит ошибка и функция просто не срабатывает

        2. Из VBA есть ограничение: значение для поиска и для замены не должно превышать 255 символов. Поэтому для корректной работы с длинными текстами надо изобретать обходные пути.

          1. Спасибо за оперативный ответ, буду что-нибудь придумывать.

  3. Дмитрий Приветствую.
    Немного изменил ваш макрос. Но не могу понять как сделать так, чтобы метка в шаблоне заменилась таблицей с листа рабочей книги.

    Вот вариант моего кода:

    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

  4. Дмитрий, приветствую!
    Помогите с небольшим нюансом. У вас в коде есть такой момент:

    'Копируем из 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} на то что скопировали??
    ???????? Подскажите пожалуйста!

    1. Евгений(или Николай) :) Если брать за основу макрос по замене по меткам, то после

      ThisWorkbook.Worksheets("{лист1}").UsedRange.Copy

      надо в коде замены Word записать вместо конкретного значения вставку из буфера обмена:

      .Find.Replacement.Text = "^c"
  5. Дмитрий, добрый день! Подскажите, пожалуйста, какой код нужен для того, чтобы в закладки шаблона Ворд передавались ячейки одного определённого столбца, именованного определенной датой? Попробую пояснить: есть таблица из 12 строк с определенными показателями которые необходимо передать в Ворд, столбцы - даты отчетов.

    1. Добрый день. Без примера данных сложно предоставить код. Если надо найти столбец с определенной датой - элементарный цикл по строке с заголовком:

      Dim lcol&, llastcol&, lResDateCol&, lHead_Row&
      Dim dtFind as Date, dt as Date
      lHead_Row = 1 'номер строки с заголовками(в этой строке записаны даты столбцов)
      llastcol = Cells(lHead_Row, Columns.Count).End(xlToLeft).Column
      dtFind = Date 'ищем столбец с текущей датой
      For lcol = 1 to llastcol
         dt = CDate(Cells(lHead_Row, lcol))
         If dt = dtFind Then
            lResDateCol = lcol
            Exit For
         End If
      Next
      If lResDateCol = 0 Then
         MsgBox "Столбец с датой " & Format(dtFind, "dd.MM.yyyy") & " не найден", vbInformation, "www.excel-vba.ru"
         End Sub
      End If

      Останется только использовать этот столбец для заполнения, видимо.

    1. Oleg1004, и что предлагаете сделать с файлами? :) Написать под них с нуля коды? Вы выслали файлы без единой строки кода и без единой попытки решить свою проблему самостоятельно. При подобном подходе это уже не помощь - это решение за Вас Вашей проблемы, а у меня нет времени на подобные вещи, у меня своя работа есть.
      Постарайтесь адаптировать код под себя - основной код и направление решения по поиску столбца есть, осталось дело за малым.
      не получится самостоятельно - обратитесь в форум(там можно и файлы прикладывать).

      1. Дмитрий, я не программист от слова "совсем". Да, мне необходимо решение этой задачи, и понимая, что любая работа оплачивается - назовите цену.

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.