Untitled

Sub UtwórzListęToDo()
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Integer
    
    ' Utwórz nowy arkusz lub użyj istniejącego
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Lista To Do"
    
    ' Nagłówki kolumn
    ws.Cells(1, 1).Value = "Postać"
    For i = 1 To 4
        ws.Cells(1, i + 1).Value = "Zadanie " & i
    Next i
    
    ' Lista postaci
    ws.Cells(2, 1).Value = "Postać 1"
    ws.Cells(3, 1).Value = "Postać 2"
    ws.Cells(4, 1).Value = "Postać 3"
    ws.Cells(5, 1).Value = "Postać 4"
    ws.Cells(6, 1).Value = "Postać 5"
    
    ' Dodanie pól wyboru
    For Each rng In ws.Range("B2:E6")
        With rng
            .ColumnWidth = 15 ' Ustawienie szerokości kolumny
            .HorizontalAlignment = xlCenter ' Wyśrodkowanie tekstu w komórce
        End With
        ws.CheckBoxes.Add(rng.Left + 5, rng.Top + 5, 15, 15).Select
    Next rng
    
    ' Ustawienie nazw dla pól wyboru
    For i = 1 To 5
        For j = 1 To 4
            ws.OLEObjects(i + (j - 1) * 5).Name = "CheckBox_" & i & "_" & j
            ws.OLEObjects(i + (j - 1) * 5).Object.Caption = ""
        Next j
    Next i
    
    ' Ustawienie nazwy arkusza jako aktywnego
    ws.Activate
    
    ' Zablokowanie zmiany rozmiaru kolumny A
    ws.Columns(1).EntireColumn.Locked = True
    ws.Protect Password:="haslo" ' opcjonalne zabezpieczenie arkusza hasłem
End Sub