循环更改后立即更新每个形状的填充颜色

Question

我试图让 Visio 在我更改每个形状后立即更新它的填充颜色。

我尝试过使用各种方法 - screenupdate、showchanges、sendkeys "%^g" 但对颜色不起作用。仅将屏幕尺寸更改 0.01% 就会强制应用更改文本，这至少是一些事情。

我可以单步执行代码并且它可以工作，但是当我运行它时，直到最后颜色都没有变化。

我正在使用以下方法更改每个对象的颜色：

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

代码遍历日期列表并在需要时更改对象的颜色，问题是它只显示最后的更改。

列表中每个项目的循环大约为一秒，足以看到任何变化。我希望有一个简单的刷新命令，但这似乎只适用于数据记录集。

有什么方法可以在更改对象填充颜色后立即刷新它？

Answer 1

应该使用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

Timer Source: