Здравствуйте, mazdacx7!
Во вложении файл Word с макросом, который берет текст из таблицы (выделен красным) и вставляет его в текст одного из шейпов во встроенном объекте Visio (также выделен красным).
Основная проблема в определении номера таблицы и номера шейпа в Visio. Если таблиц не много, то можно и посчитать, иначе потребуется какое-то другое решение (например,
ТАКОЕ). С шейпом все несколько сложнее, т.к. в обычном режиме Visio можно через меню вызвать окно свойств, в заголовке которого есть имя шейпа (имя можно использовать вместо ID, только вводится оно в двойных кавычках), но тут это меню недоступно. В коде есть закомментированый цикл, который позволяет посмотреть все непустые подписи к шейпам и при этом содержит ID шейпа - можно использовать что-то похожее.
По аналогии с представленным кодом можно сделать связь других полей и подписей в объектах.
Остается выбрать способ, которым будут обновляться данные на объектах (например, при сохранении документа или его открытии), но тут выбор за Вами.
Код с комментариями продублирован в приложении.
Приложение:
Sub Main()
'объявляем переменные
' таблица, строка из таблицы, встроенный объект
Dim myTable As Table, myString As String, myObject As Object, i As Long
'присваиваем значение (13 - порядковый номер таблицы в документе)
Set myTable = ActiveDocument.Tables(13)
'считываем в переменну значение из ячейки (5 - строка, 6 - столбец)
'считываем всю строку кроме последнего символа - символа конца ячейки
myString = Left(myTable.Cell(5, 6).Range, Len(myTable.Cell(5, 6).Range) - 1)
'активируем OLE-объект с номером 1 (первый вставленный объект)
ThisDocument.InlineShapes(1).OLEFormat.Activate
'присваиваем значение переменной объекта
Set myObject = ThisDocument.InlineShapes(1).OLEFormat.Object
'изменяем текстовую подпись объекта с номером 52 на строку из таблицы
myObject.Application.ActivePage.Shapes(52).Text = myString
'цикл для получения всех номеров объектов с непустой подписью
'For i = 1 To myObject.Application.ActivePage.Shapes.Count
'If myObject.Application.ActivePage.Shapes(i).Text <> "" Then
'MsgBox "Object ID: " & i & vbCrLf & myObject.Application.ActivePage.Shapes(i).Text
'End If
'Next i
End Sub