Макрос № 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

Комментариев нет:
Отправить комментарий