Используя vba, я пытаюсь получить visio, чтобы обновить цвет заливки каждой фигуры после ее изменения. - PullRequest
Новая
       16

Используя vba, я пытаюсь получить visio, чтобы обновить цвет заливки каждой фигуры после ее изменения.

2 голосов
/ 28 июня 2019

Используя vba, я пытаюсь получить visio для обновления цвета заливки каждой фигуры после ее изменения.

Я пробовал использовать различные методы - screenupdate, showchanges, sendkeys "% ^ g", но ничего не работает с цветом.Только изменение размера экрана на 0,01% заставляет приложение изменять текст, что является чем-то еще.Я могу пройти по коду, и он работает, но когда я его запускаю, ни один из цветов не меняется до конца.

Я меняю цвет каждого объекта, используя: 

Application.ActiveWindow.Page.Shapes.ItemFromID(servshape(y - 1)).CellsU("Fillforegnd").FormulaU = "RGB(253, 190, 0)"

Код выполняется по списку дат и при необходимости меняет цвет объектов, проблема в том, что он показывает только изменения в конце, цикл по каждому элементу в списке составляет ок.1 - достаточно долго, чтобы увидеть какие-либо изменения, надеялся, что есть простая команда обновления, но, по-видимому, она работает только с наборами данных, есть ли способ обновить цвет заливки объекта после его изменения?спасибо

1 Ответ

0 голосов
/ 28 июня 2019

Должно работать с DoEvents: 

Option Explicit

Sub reColorAll()
    Dim pg As Visio.Page
    'Set pg = Application.ActiveWindow.Page
    Set pg = ActivePage ' Probably what you want



    Dim shp As Visio.Shape
    For Each shp In pg.Shapes
        If True Then 'test if shape is one of the ones you want, replace true with test
            If shp.CellExistsU("Fillforegnd", False) Then 'test if cell even exists
                shp.CellsU("Fillforegnd").FormulaU = "RGB(253, 190, 0)"
                DoEvents' force Application to update
            End If

            'Timer to simulate delay, can be removed for your case
            Dim pauseTime As Long
            Dim start As Long
            pauseTime = 1   ' Set duration in seconds
            start = Timer    ' Set start time.
            Do While Timer < start + pauseTime
            Loop
            'End Timer Code

        End If
    Next shp

End Sub

Источник таймера:

...