Private Sub CheckBox2100_Click()
With ActiveSheet.ListObjects("tblCennik").ListColumns("Checkbox").DataBodyRange
If .SpecialCells(xlCellTypeVisible).Count < .Rows.Count Then
On Error Resume Next
Application.EnableEvents = False
.SpecialCells(xlCellTypeVisible).Value = Range("B5").Value
Application.EnableEvents = True
On Error GoTo 0
End If
End With
End Sub
It needs improvement, perhaps to reset to unchecked when no checkboxes are selected in the table..
By the way, I copied somewhere this very valuable code that should go together in my notebook. It attaches checkboxes to cells in a column. I wish I could say thanks to the author, when I find the source I will definitely acknlwedge the author:
Sub UpdateList()
Dim oCheck As OLEObject
Dim rCell As Range
'clear existing checkboxes
For Each oCheck In Sheet1.OLEObjects
oCheck.Delete
Next oCheck
'update the external data
'Sheet1.QueryTables(1).Refresh False
'add new checkboxes
With Sheet1.ListObjects("tblCennik").ListColumns("Checkbox").DataBodyRange
For Each rCell In .Columns(1).Cells
If rCell.Row > .Rows(1).Row Then
'rCell.RowHeight = 14 'this makes the checkbox look nicer
With Sheet1.OLEObjects.Add(classtype:="Forms.Checkbox.1", _
Top:=rCell.Top, Left:=rCell.Left, _
Height:=rCell.Height, Width:=rCell.Width)
.Placement = XlPlacement.xlMoveAndSize
.Object.Caption = ""
.LinkedCell = rCell.Address
.Object.Value = False
End With
End If
Next rCell
End With
End Sub
