Excel宏复选框

时间:2017-10-01 09:33:07

标签: excel excel-vba checkbox excel-2007 checkboxlist vba

我有这张桌子

table

并且,如果可能的话,使用宏,我想:

  1. 选中价值30%的复选框时,会复制到“已选择的总数”30%

  2. 用户只能选中一个方框

  3. 我只想在用户选中评估point1的方框时,他会选择其中一个评级(0%-30%-60%-100%),他选择的任何内容都会复制到总重量值。

  4. 我不知道如何为每个盒子定义一个值?

1 个答案:

答案 0 :(得分:0)

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

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

我不明白你想要在"总重量"柱。您可以使用工作表函数填充该列。