Макрос № 1 Рабочий
Подготовка файлов.
В Excel файле:
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_001". BM-латиницей
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_002" . и т.д
В Word
- Создаем закладку путем нажатия кнопок: CTRL+SHIFT+F5 или Вставка - Закладка, задаем имя как в Excel "BM_имяЛиста_001" BM-латиницей- Чтобы закладку использовать много раз в разных местах документа Word илспользуйте действие:
Далее Макрос № 1 вставляем в Excel и привязываем его к кнопке
Макрос № 2 Рабочий
Подготовка тут немного хитрее.
Файл Excel и Word должны располагаться в одной папке
В файл Excel пихаем макрос.
В Word создаем закладку старого типа:
- и задаем имя закладки на латинице "BM_имяЛиста_001" и т.д
Подготовка файлов.
В Excel файле:
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_001". BM-латиницей
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_002" . и т.д
В Word
- Создаем закладку путем нажатия кнопок: CTRL+SHIFT+F5 или Вставка - Закладка, задаем имя как в Excel "BM_имяЛиста_001" BM-латиницей- Чтобы закладку использовать много раз в разных местах документа Word илспользуйте действие:
- Копируем имя закладки
- Нажимаем CTRL+F9 - результат: { такие скобки на сером фоне }
- Пишем внутри этих скобок { REF BM_имяЛиста_001 }
- Для обновления данных нажмите: F9
Далее Макрос № 1 вставляем в Excel и привязываем его к кнопке
Sub Test() Dim DocFile As String DocFile = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Старт").Range("A1").Text & ".docx" 'Лист "Старт" Имя файла указан в строке A1 Const MyDebug As Boolean = True ' Флаг отладки True Dim i As Integer Dim ch As String Dim IsNewApp As Boolean ' Попытаться использовать ранее открытое приложение WinWord (это быстрее) On Error Resume Next Set objWord = GetObject(, "Word.Application") If Err Then ' Открытое приложение WinWord не найдено - создать новое Set objWord = CreateObject("Word.Application") IsNewApp = True End If objWord.Visible = True objWord.Activate On Error GoTo exit_ ' Открыть документ DocFile objWord.Visible = True Set mDOK = objWord.Documents.Open(DocFile) ' открываем документ For i = 1 To ActiveWorkbook.Names.Count If ActiveWorkbook.Names(i).Name Like "BM_*" Then Call UpdateBookmarks(ActiveWorkbook.Names(i).Name, Range(ActiveWorkbook.Names(i).Name).Value) End If Next i exit_: ' Обязательно освободить память, занимаемую объектной переменной Set objWord = Nothing ' При ошибке - сообщить 'If Err Then MsgBox Err.Description, vbCritical, "Ошибка" ErrMsg = "" If Err Then ErrMsg = "В ходе выполнения произошла ошибка: " & Err.Description MsgBox "Закладки обновлены. " & ErrMsg End Sub Private Sub UpdateBookmarks(NameOfBookmark As String, ContentOfBookmark As String) On Error Resume Next Dim oRng As Object Dim oBm As Object Set oBm = mDOK.Bookmarks ' в переменную закладки документа Set oRng = oBm(NameOfBookmark).Range ' в переменную имена закладок документа oRng.Text = ContentOfBookmark ' содержание закладок oBm.Add NameOfBookmark, oRng NameOf End Sub
Макрос № 2 Рабочий
Подготовка тут немного хитрее.
Файл Excel и Word должны располагаться в одной папке
В файл Excel пихаем макрос.
В Word создаем закладку старого типа:
- и задаем имя закладки на латинице "BM_имяЛиста_001" и т.д
Sub CreateWord() ' ' Создание ' Set appWord = CreateObject(Class:="Word.Application") appWord.Visible = True strFileName = ThisWorkbook.Path & "\Otchet.docm" 'Имя файла Set doc = appWord.Documents.Open(Filename:=strFileName) doc.FormFields("BM_имяЛиста_001").Result = Worksheets("имяЛиста").Cells(4, 2).value 'Значение из Cells(строка, столбец) doc.FormFields("BM_имяЛиста_002").Result = Worksheets("имяЛиста").Cells(4, 3).value doc.FormFields("BM_имяЛиста_003").Result = Worksheets("имяЛиста").Cells(4, 7).value End Sub
Комментариев нет:
Отправить комментарий