vba - 加快 VBA 中按钮格式化的速度

Question

我有下面的代码，将所有按钮(有 10 个)着色为灰色，以清除任何先前着色的按钮，然后将所选按钮着色为蓝色。基本上充当当前选择哪个按钮的指示器。我注意到代码现在需要一些时间才能通过这种修饰添加来运行，我想知道是否有任何方法可以重新编写它以运行得更快？

感谢您的帮助，如果我可以提供更多详细信息，请告诉我

'
' all_days Macro

'change all buttons to grey first
      ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 17", _
        "Rectangle: Rounded Corners 12", "Rectangle: Rounded Corners 11")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.5
        .Transparency = 0
        .Solid
    End With
    
'change selected button to blue
     ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 12")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0
        .Solid
    End With
    
    ActiveSheet.Range("$A$1:$X$740").AutoFilter Field:=12
    ActiveSheet.Range("$A$1:$X$100000").AutoFilter Field:=17
End Sub```

Answer 1

突出显示单击的形状

Sub HighlightClickedShape()
    
    Dim ShapeNames() As Variant
    ShapeNames = Array("Rectangle: Rounded Corners 17", _
        "Rectangle: Rounded Corners 12", "Rectangle: Rounded Corners 11")
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim shprg As ShapeRange: Set shprg = ws.shapes.Range(ShapeNames)
    
    ResetShapeRange shprg
    
    Dim shp As Shape
    On Error Resume Next
        Set shp = shprg(Application.Caller)
    On Error GoTo 0
    
    If shp Is Nothing Then
        MsgBox "This only works when clicking on one of the following shapes:" _
            & vbLf & vbLf & Join(ShapeNames, vbLf), vbCritical
        Exit Sub
    End If
    
    HighlightShape shp

End Sub

Sub ResetShapeRange(ByVal shprg As ShapeRange)
    With shprg.Fill.ForeColor
        .ObjectThemeColor = msoThemeColorBackground1
        .Brightness = -0.5
    End With
End Sub

Sub HighlightShape(ByVal shp As Shape)
    With shp.Fill.ForeColor
        .ObjectThemeColor = msoThemeColorAccent1
        .Brightness = -0.25
    End With
End Sub