CheckBox в ячейках Excel

25 апреля 2013, VBA, Konstantin

Следующий код, помещённый в VBA редакторе на соответствующий лист, позволяет двойным кликом левой кнопки мыши по ячейке в первом столбце устанавливать в ней попеременном галочку, либо крестик.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 With Target
     If .Column = 1 Then
         Select Case .Value
                Case Is = "a"
                     .Font.Name = "Marlett"
                     .Value = "r"
                 Case Is = "r"
                     .Font.Name = "Marlett"
                     .Value = "a"
                 Case Else
                     .Font.Name = "Marlett"
                     .Value = "a"
         End Select
     Cancel = True
     End If
 End With
End Sub

Результат работы макроса выглядит следующим образом:

Excel_CheckBox
Источник

Теги:
 

3 комментария в “CheckBox в ячейках Excel”

  1. eveltek:

    Очень полезный макрос! А как в нем сделать так чтобы при 1 нажатии мышки ставилась галочка, а при втором единичном нажатии она просто убиралась?

    и еще чтобы если галочка например стоит в А1, чтобы В1 закрашивалось в зеленый цвет, а снимаешь галочку – снова В1 белая.

    • Чтобы галочка просто убиралась и окрашивалась указанная ячейка нужно лишь немного изменить код:

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
       With Target
           If .Column = 1 Then
               Select Case .Value
                      Case Is = "a"
                           .Font.Name = "Marlett"
                           .Value = ""
                           With Cells(1, 2).Interior
                              .Pattern = xlNone
                           End With
                       Case Else
                           .Font.Name = "Marlett"
                           .Value = "a"
                           With Cells(1, 2).Interior
                              .Color = 5287936
                          End With
               End Select
           Cancel = True
           End If
       End With
      End Sub
  2. Chupacabras:

    Прочитайте другие статьи, решающие похожие задачи в MS Excel. Это позволит Вам решать широкий класс подобных задач.

Комментировать