Здравствуйте. Попробуйте так
[vba]Код
Sub Word_start()
Dim sOM As String, sDocNum As String
Dim WordApp As Object
Dim sNumber As String, bkmName As String, Shp As Shape
Dim Gabar_sxema As String
Dim Perem_dan As Range
'Подключение к Word документу
sOM = "C:\Users\admin\Desktop\таблица выделения.docx"
'Проверка наличия документа Word и запуск если нет ошибок
On Error Resume Next
Set WordApp = GetObject(, "word.application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("word.application")
End If
On Error GoTo 0
With WordApp
.Visible = True
.Documents.Open Filename:=sOM
End With
'Получение данных из Excel
xlog_G = Range("log_G").Value 'Группа
'присвоить переменномо для выбора в таблице
Gabar_sxema = xlog_G
'присвоение sNumber значения из массива
sNumber = Split(Gabar_sxema)(0)
bkmName = "FunEst_tabl_osadca" & sNumber
WordApp.ActiveDocument.Bookmarks(bkmName).Range.Shading.BackgroundPatternColor = -738132071
Set WordApp = Nothing
End Sub
[/vba]