Insertar casillas en muchas celdas (con VBA)

Si quieres que se agregue una casilla de verificación a todo un rango, usa una macro:

  1. Presiona Alt + F11 para abrir el Editor de VBA.
  2. Ve a Insertar → Módulo y pega este código:
Sub InsertarCasillasVinculadasVerde()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim celda As Range, area As Range
    Dim chk As CheckBox
    Dim alto As Double, ancho As Double, L As Double, T As Double
    Dim addr As String

    '--- Parámetros ajustables ---
    Const MIN_ROW_HEIGHT As Double = 18   ' altura mínima para que no se recorte
    Const MARGEN As Double = 2            ' margen interno (pt) para no tocar bordes
    Const RATIO_ANCHO As Double = 1.8     ' ancho = alto * RATIO (1.5–2.2 suele verse bien)

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For Each celda In Selection
        Set area = celda.MergeArea
        addr = area.Cells(1, 1).Address(False, False)

        ' 1) Asegurar altura mínima (para que entre el control)
        On Error Resume Next
        If area.Rows.RowHeight < MIN_ROW_HEIGHT Then area.Rows.RowHeight = MIN_ROW_HEIGHT
        On Error GoTo 0

        ' 2) Borrar checkbox existente anclado a esa celda/área
        For Each chk In ws.CheckBoxes
            If chk.TopLeftCell.Address = area.Cells(1, 1).Address Then chk.Delete
        Next chk

        ' 3) Calcular tamaño RECTANGULAR:
        '    - Alto limitado por la altura de la celda menos márgenes.
        '    - Ancho = alto * RATIO, pero no mayor que el ancho disponible menos márgenes.
        alto = Application.Max(10, area.Height - 2 * MARGEN)
        ancho = alto * RATIO_ANCHO
        If ancho > (area.Width - 2 * MARGEN) Then ancho = area.Width - 2 * MARGEN
        ' si la celda es muy angosta, evita negativos
        If ancho < 10 Then ancho = Application.Max(10, area.Width - 2)

        ' 4) Crear checkbox y centrarlo
        Set chk = ws.CheckBoxes.Add(area.Left, area.Top, ancho, alto)
        With chk
            .Caption = ""                  ' sin texto (evita "angosto")
            .LinkedCell = addr             ' vincular a la celda (VERDADERO/FALSO)
            .Placement = xlMoveAndSize     ' se mueve/redimensiona con la celda
            .Width = ancho
            .Height = alto
            ' Centrado dentro del área
            L = area.Left + (area.Width - .Width) / 2
            T = area.Top + (area.Height - .Height) / 2
            .Left = L
            .Top = T
        End With

        ' 5) Ocultar visualmente VERDADERO/FALSO (la celda queda "transparente")
        area.NumberFormat = ";;;"

        ' 6) Formato condicional: verde cuando sea VERDADERO
        On Error Resume Next
        area.FormatConditions.Delete ' limpia reglas previas para no duplicar
        On Error GoTo 0

        Dim fc As FormatCondition
        Set fc = area.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=VERDADERO")
        With fc
            .Interior.Color = RGB(198, 239, 206)   ' verde claro
            .StopIfTrue = False
        End With
    Next celda

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Extras útiles (opcionales)

  • Eliminar todas las casillas del rango seleccionado:
Sub EliminarCasillasEnSeleccion()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim chk As CheckBox
    Dim vinc As String
    Dim c As Range

    Application.ScreenUpdating = False

    ' Eliminar casillas del rango seleccionado
    For Each chk In ws.CheckBoxes
        If Not Intersect(chk.TopLeftCell, Selection) Is Nothing Then
            On Error Resume Next
            vinc = chk.LinkedCell
            If Len(vinc) > 0 Then
                Range(vinc).ClearContents   ' borrar TRUE/FALSE
            End If
            On Error GoTo 0
            chk.Delete
        End If
    Next chk

    ' Limpiar color y formato
    For Each c In Selection
        On Error Resume Next
        c.FormatConditions.Delete
        On Error GoTo 0
        c.Interior.Pattern = xlNone        ' sin color
        If c.NumberFormat = ";;;" Then c.NumberFormat = "General"
    Next c

    Application.ScreenUpdating = True
End Sub
  • Recentrar y reajustar tamaño (si cambiaste alturas/anchos de filas/columnas después):
Sub RecentrarYRedimensionarCasillas()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim chk As CheckBox
    Dim area As Range
    Dim w As Double, h As Double
    Dim ancho As Double, alto As Double
    Dim L As Double, T As Double
    Const RATIO_ANCHO As Double = 1.8
    Const MARGEN As Double = 2
    Const MIN_ROW_HEIGHT As Double = 18

    Application.ScreenUpdating = False

    For Each chk In ws.CheckBoxes
        If Not Intersect(chk.TopLeftCell, Selection) Is Nothing Then
            Set area = chk.TopLeftCell.MergeArea
            If area.Rows.RowHeight < MIN_ROW_HEIGHT Then area.Rows.RowHeight = MIN_ROW_HEIGHT

            w = area.Width: h = area.Height
            alto = Application.Max(10, h - 2 * MARGEN)
            ancho = alto * RATIO_ANCHO
            If ancho > (w - 2 * MARGEN) Then ancho = w - 2 * MARGEN
            If ancho < 10 Then ancho = Application.Max(10, w - 2)

            With chk
                .Caption = ""                 ' sin texto
                .Placement = xlMoveAndSize
                .Width = ancho
                .Height = alto
                L = area.Left + (w - .Width) / 2
                T = area.Top + (h - .Height) / 2
                .Left = L
                .Top = T
            End With

            ' Ocultar texto TRUE/FALSE en la celda vinculada
            area.NumberFormat = ";;;"
        End If
    Next chk

    Application.ScreenUpdating = True
End Sub
  1. Cierra el editor y vuelve a Excel.

  2. Selecciona el rango donde quieres las casillas (por ejemplo B2:B20).

  3. Presiona Alt + F8, elige InsertarCasillasVinculadas, y ejecuta.

  4. =CONTAR.SI(G142:AD142,VERDADERO)