poniedziałek, 7 września 2015

VBA - Ticking a "Check all visible/filtered out" checkbox

I would like to have a tickbox at the top of the table to select all other tick'boxes within the table . I assume my tickbox should operate only if some data is filtered out and some rows hidden. Then my humble code looks like this.:



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

Brak komentarzy:

Prześlij komentarz