XL 2019 Création de cases à cocher dynamiquement

Const PremColQ = 3      ' N° colonne du TS de la première question
Const DerColQ = 6       ' N° colonne du TS de la dernière question

Option Explicit

Const PremColQ = 3      ' N° colonne du TS de la première question
Const DerColQ = 6       ' N° colonne du TS de la dernière question

Sub CreerCases()
Dim ts As ListObject, j&, x As Range, chk, MaChk, Old
 
   Application.ScreenUpdating = False
   Set ts = Range("a1").ListObject                          ' le tableau structuré en cellule A1
   For j = PremColQ To DerColQ                              ' pour chaque colonne de question
      ts.ListColumns(j).DataBodyRange.NumberFormat = ";;;"  ' le format masque la valeur de la cellule
      For Each x In ts.ListColumns(j).DataBodyRange         ' pour chaque cellule x de la colonne question j
         Old = x.Value                          ' Old est la valeur de la cellule
         Set MaChk = Nothing                    ' la case à cocher de la cellule : on présuppose qu'elle est absente
         For Each chk In Me.CheckBoxes          ' boucle sur les CheckBox existantes (indice de boucle chk)
            If chk.TopLeftCell.Address = x.Address Then  ' si le coin sup. droit de chk est l'adresse de la cellule x
                                                         '  alors c'est la checkbox de la cellule
               Set MaChk = chk                  ' on affecte cette checkbox existante  à la variable MaChk
               Exit For                         ' on a trouvé la checkbox, on quitte donc la boucle de recherche
            End If
         Next chk
         If MaChk Is Nothing Then                                 ' on n'a pas trouvé la checkbox de la cellule x
            Set MaChk = Me.CheckBoxes.Add(x.Left, x.Top, 10, 10)  ' on en crée une nouvelle
            MaChk.LinkedCell = x.Address                          ' et on la LIE à la cellule x
         End If
         With MaChk                 ' avec la case à cocher de la cellule x
            If Old = True Then      ' si la valeur de la cellule est True ('Vrai)
               .Value = True        ' on met la valeur de la checkbox à True (cochée)
            Else
               .Value = False       ' sinon on met la valeur de la checkbox à False (décochée)
               x = False            ' et la cellule est mise à False aussi
            End If
            ' on met en forme et on positionne la case à cocher de la cellule x
            .Characters.Text = ""                     ' le texte
            .Height = x.RowHeight - 1                 ' la hauteur
            .Width = 20                               ' la largeur
            .Top = x.Top + (x.Height - .Height) / 2   ' la position verticale
            .Left = x.Left + (x.Width - .Width) / 2   ' la position horizontale
            .Display3DShading = True                  ' le type de case (3D)
         End With
      Next x         ' on passe à la cellule suivante de la colonne
   Next j            ' on passe à la colonne de question suivante
End Sub