VBA 中的是/否框答案

【问题标题】：Yes/No boxes in VBAVBA 中的是/否框
【发布时间】：2022-11-24 03:44:39
【问题描述】：

我在 for 循环中创建了一组形状，并想为每个形状分配简单的代码作为“是/否”按钮。

创建按钮数组的代码如下：

    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    

    For i = 1 To 3
        For j = 2 To 17
            ActiveSheet.Shapes.addshape(msoShapeRectangle, Cells(j, i).Left + 0, _
                Cells(j, i).Top + 0, Cells(j, i).Width, Cells(j, i).Height).Select
        Next j
    Next i

我希望能够在创建形状时为每个形状分配代码，但不知道如何。我希望代码为每个形状执行的操作如下所示。我希望形状在单击时做出反应，并循环显示每个形状中的是/否/空白文本。代码的一般逻辑如下

       value = value +1
       if value = 1, then "yes" and green
       if value = 2, then "no" and red
       if value = 3, then value = 0 and blank and grey

预先感谢您的帮助

【问题讨论】：

看看Shapes.AddShape。您可以用 51 个相同的按钮快速填满您的工作表。然后您只需复制并粘贴 Button_Click 事件脚本 51 次。
您可以使用.onaction 来分配事件。
根据您的主要要求：您还可以让用户单击（受保护的）单元格（不是形状）——然后使用 worksheet_selectionchange 事件将单元格的值更改为“是”、“否”或空白。如果 51 个单元格中的每一个都有唯一的名称 - 您可以使用它们
如果您想添加代码 - 编辑您的问题并将其添加到那里，以便我们阅读。
@TimWilliams 我编辑了问题，这是否阐明了我在寻找什么？

标签： excel vba macros shapes

【解决方案1】：

你可以这样做：

Option Explicit

Sub Tester()
    
    Dim i As Long, j As Long, k As Long
    Dim addr As String, shp As Shape

    For i = 1 To 3
        For j = 2 To 17
            With ActiveSheet.Cells(j, i)
                Set shp = .Parent.Shapes.AddShape(msoShapeRectangle, .Left + 0, _
                                                  .Top + 0, .Width, .Height)
                With shp.TextFrame2
                    .VerticalAnchor = msoAnchorMiddle
                    .TextRange.ParagraphFormat.Alignment = msoAlignCenter
                End With
                shp.Name = "Button_" & .Address(False, False)
            End With
            shp.Fill.ForeColor.RGB = RGB(200, 200, 200)
            shp.OnAction = "ButtonClick"
        Next j
    Next i
End Sub

'called from a click on a shape
Sub ButtonClick()
    Dim shp As Shape, capt As String, tr As TextRange2
    
    'get a reference to the clicked-on shape
    Set shp = ActiveSheet.Shapes(Application.Caller)
    Set tr = shp.TextFrame2.TextRange
    
    Select Case tr.Text 'decide based on current button text
        Case "Yes"
            tr.Text = ""
            shp.Fill.ForeColor.RGB = RGB(200, 200, 200)
        Case "No"
            tr.Text = "Yes"
            shp.Fill.ForeColor.RGB = vbGreen
        Case ""
            tr.Text = "No"
            shp.Fill.ForeColor.RGB = vbRed
    End Select
End Sub

【讨论】：