пятница, 27 марта 2020 г.

Из Excel в Word (данные из ячейки) в закладку Word Макросом

Макрос № 1 Рабочий
Подготовка файлов.
В Excel файле:
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_001".  BM-латиницей
- в любой ячейке пишем формулу или любое значение - задаем этой ячейке имя (Формулы - Присвоить имя) Имя задаем как: " BM_имяЛиста_002" . и т.д

В Word
- Создаем закладку путем нажатия кнопок:  CTRL+SHIFT+F5  или Вставка - Закладка,  задаем имя как в Excel  "BM_имяЛиста_001" BM-латиницей- Чтобы закладку использовать много раз в разных местах документа Word илспользуйте действие: 
  1. Копируем имя закладки
  2. Нажимаем CTRL+F9 - результат: { такие скобки на сером фоне }
  3. Пишем внутри этих скобок  {  REF  BM_имяЛиста_001  }
  4. Для обновления данных нажмите: F9
Чтобы увидеть все закладки созданные путем нажатия CTRL-F9, нажмите ALT+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

Комментариев нет:

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