Excel 宏复选框

Question

我有这张桌子

如果可能的话，我想使用宏：

1. 检查具有值30％的框时，它将复制到“选定的总选定”30％

2. 用户只能勾选一个框

3. 我只想当用户选中该框以评估点 1 时，他会选择其中一个评级 (0%-30%-60%-100%)，并且他选择的任何内容都会复制到总重量值。

我不知道如何为每个框定义一个值？

Answer 1

这段代码应该主要完成你想要的工作。将其安装在您希望对其执行操作的工作表的代码表中。请注意，您不需要该表上的复选框。代码正在创建它们。但是您确实需要格式化该工作表上的单元格，以按照您想要的方式显示数字（而不是复选框）。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 01 Oct 2017

    Dim Rng As Range

    On Error GoTo ErrExit
    If Target.Cells.Count > 1 Then Exit Sub

    ' Specify the range where you want checkboxes to appear when clicked:-
    ' the range is defined as starting from C2 end ending
    ' at the cell in column F in the last used row in column A

    ' if column A has a fixed number of entries, like "Point 1 to Point 5"
    ' "Cells(Rows.Count, "A").End(xlUp).Row" may be replaced by a fixed row number
    Set Rng = Range(Cells(2, "C"), _
                    Cells(Cells(Rows.Count, "A").End(xlUp).Row, "F"))

    On Error GoTo 0
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        With Target
            Set Rng = Range(Cells(.Row, Rng.Column), _
                            Cells(.Row, Rng.Column + Rng.Columns.Count))
            Rng.ClearContents

            ' Column "B" is "Total selected"
            ' it is assigned the value from row 1
            Cells(.Row, "B").Value = Cells(1, .Column).Value
            .Font.Name = "Wingdings"
            .Font.Size = 14                 ' set the font size as required
            .HorizontalAlignment = xlCenter
            .Value = ChrW(254)
        End With
    End If

    Exit Sub

ErrExit:
    ' the likely reason is that column A is blank.
    ' Make sure that there is an entry in column A
    ' for every row in which you may want to set a checkbox
    MsgBox Err & vbCr & Err.Description, _
           vbCritical, "Malfunction"
End Sub

我不明白您想在“总重量”列中显示什么。您可以使用工作表函数填充该列。