Как из Excel обратиться к другому приложению

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

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

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

      .Find.Replacement.Text = "^c"

      .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

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

      Войдите, чтобы ответить

6. Дмитрий, есть файлы с примерами, а как их вложить?

   Войдите, чтобы ответить

7. Отправил почтой.

   Войдите, чтобы ответить

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

      Войдите, чтобы ответить

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

         Войдите, чтобы ответить

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