VBA灰色复选框

ste*_*ris 3 checkbox excel vba excel-vba

我想在Excel VBA中清除我的复选框.使用时Checkbox.Enabled = False,该复选框不可编辑,但也不是灰色.如何获得灰色效果?

在Excel 2010中使用表单控件.通过开发人员选项卡直接插入到Excel工作表中.未在VBA用户表单中使用.

谢谢!

Flo*_*ris 9

每当有人说"这是不可能的"时,就会触及我的顽固连胜.所以我可以向你呈现:"不可能".

"可见"并启用复选框:

在此输入图像描述

"已禁用"复选框(您可以通过更改代码中颜色和封面形状透明度的值来调整可见度):

在此输入图像描述

基本思路:在复选框上放置一个半透明的形状,并为其指定一个虚拟宏.现在您无法更改复选框的值."切换"按钮用于更改状态 - 放置形状或移除它们.它使用全局变量来跟踪当前状态.

最后 - 请注意,For Each删除(或添加)形状时不能使用,因为您不应该修改正在迭代的集合.我通过一个简单的"计数形状,然后通过数字索引向后迭代"来规避它.

这是一个黑客?你打赌!它会按你的要求做吗?是!

Dim checkBoxesVisible As Boolean
Option Explicit

Sub toggleIt()
' macro assigned to "Toggle visibility" button
  checkBoxesVisible = Not checkBoxesVisible
  toggleCheckboxes checkBoxesVisible
End Sub

Sub grayOut(cb)
' put a "cover" shape over a checkbox
' change the color and transparency to adjust the appearance
  Dim cover As Shape
  Set cover = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cb.Left, cb.Top, cb.Width, cb.Height)
  With cover
    .Line.Visible = msoFalse
    With .Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0.4
        .Solid
    End With
  End With
  cover.Name = "cover"
  cover.OnAction = "doNothing"
End Sub

Sub doNothing()
' dummy macro to assign to cover shapes
End Sub

Sub unGray(cb)
' find the cover shape for the checkbox passed as the argument
' and delete it
' "correct shape" has the name "cover" and is properly aligned with top left
  Dim sh As Shape
  For Each sh In ActiveSheet.Shapes
    If sh.Name = "cover" And sh.Left = cb.Left And sh.Top = cb.Top Then
      sh.Delete
      Exit For
    End If
  Next sh
End Sub

Sub toggleCheckboxes(onOff)
  Dim s As Shape
  Dim n As Integer, ii As Integer

  n = ActiveSheet.Shapes.Count
  ' loop backwards over shapes: if you do a "For Each" you get in trouble
  ' when you delete things!

  For ii = n To 1 Step -1
    Set s = ActiveSheet.Shapes(ii)
    If s.Type = msoFormControl Then
      If s.FormControlType = xlCheckBox Then
        If onOff Then
          unGray s
        Else
          grayOut s
        End If
      End If
    End If
  Next ii

End Sub
Run Code Online (Sandbox Code Playgroud)