Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Заливка ячейки в таблицы Word по условию через VBA Excel. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Заливка ячейки в таблицы Word по условию через VBA Excel.
ediczr Дата: Воскресенье, 16.07.2017, 15:40 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день.
Не могу разораться как сформулировать VBA запрос в Excel для заливки ячейки в таблице Word (Граница и заливка -> Заливка).
VBA скрипт работает с заливкой фона текста в таблице Word.
Заранее благодарен за любую помощь.

[vba]
Код

Sub Word_start()

Dim sOM As String, sDocNum As String
Dim WordApp As Object
Dim sNumber 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)
        
'выбор элемента для отрытиял боков элементов
            Select Case sNumber
            
                Case "1": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca1").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "2": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca2").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "3": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca3").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "4": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca4").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "5": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca5").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "6": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca6").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "7": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca7").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "8": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca8").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "9": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca9").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "10": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca10").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "11": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca11").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "12": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca12").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "13": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca13").Range.Font.Shading.BackgroundPatternColor = -738132071
                        
            End Select
    
    Set WordApp = Nothing

End Sub

[/vba]
К сообщению приложен файл: 4972827.docx (12.9 Kb) · __.xlsm (13.5 Kb)
 
Ответить
СообщениеДобрый день.
Не могу разораться как сформулировать VBA запрос в Excel для заливки ячейки в таблице Word (Граница и заливка -> Заливка).
VBA скрипт работает с заливкой фона текста в таблице Word.
Заранее благодарен за любую помощь.

[vba]
Код

Sub Word_start()

Dim sOM As String, sDocNum As String
Dim WordApp As Object
Dim sNumber 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)
        
'выбор элемента для отрытиял боков элементов
            Select Case sNumber
            
                Case "1": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca1").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "2": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca2").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "3": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca3").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "4": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca4").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "5": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca5").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "6": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca6").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "7": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca7").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "8": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca8").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "9": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca9").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "10": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca10").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "11": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca11").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "12": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca12").Range.Font.Shading.BackgroundPatternColor = -738132071
                Case "13": WordApp.ActiveDocument.Bookmarks("FunEst_tabl_osadca13").Range.Font.Shading.BackgroundPatternColor = -738132071
                        
            End Select
    
    Set WordApp = Nothing

End Sub

[/vba]

Автор - ediczr
Дата добавления - 16.07.2017 в 15:40
Pelena Дата: Воскресенье, 16.07.2017, 17:12 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19402
Репутация: 4554 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте. Попробуйте так
[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]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте. Попробуйте так
[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]

Автор - Pelena
Дата добавления - 16.07.2017 в 17:12
ediczr Дата: Воскресенье, 16.07.2017, 17:35 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Все работает, огромная благодарность Pelena и спасибо форуму http://www.excelworld.ru
hands
 
Ответить
СообщениеВсе работает, огромная благодарность Pelena и спасибо форуму http://www.excelworld.ru
hands

Автор - ediczr
Дата добавления - 16.07.2017 в 17:35
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!