Question

使用vba，我尝试在更改形状后让visio更新每个形状的填充颜色。

我尝试使用各种方法-screenupdate，showchanges，sendkeys“％^ g”，但是没有任何颜色可以使用。仅将屏幕尺寸更改0.01％会强制应用更改文本，至少是这样。我可以逐步执行代码，并且可以运行，但是当我运行它时，所有颜色都不会改变，直到最后。

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

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

该代码遍历日期列表，并在需要时更改对象的颜色，问题是它仅显示最后的更改，列表中每个项目的循环约为。 1秒钟-足以看到任何更改，希望有一个简单的刷新命令，但似乎只适用于datarecordsets，是否有任何方法可以在更改对象后刷新对象填充颜色？谢谢

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:

我使用vba尝试让visio在更改形状后更新每个形状的填充颜色

1 个答案: