Insertar casillas en muchas celdas (con VBA)
Si quieres que se agregue una casilla de verificación a todo un rango, usa una macro:
- Presiona Alt + F11 para abrir el Editor de VBA.
- 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
-
Cierra el editor y vuelve a Excel.
-
Selecciona el rango donde quieres las casillas (por ejemplo
B2:B20). -
Presiona Alt + F8, elige InsertarCasillasVinculadas, y ejecuta.
-
=CONTAR.SI(G142:AD142,VERDADERO)