Microsoft 365 Problème de tableau structuré

Public Const TableauxModifiables = "=TS_Actif1=TS_Actif2="

Sub ReInitMenuContext()
     Application.CommandBars.Item("List Range Popup").Reset
End Sub

Sub ChangeMenuContextListObject(LO As ListObject)
     Dim Ctrl As CommandBarControl, BCtrlI As CommandBarPopup, BCtrl1 As CommandBarButton, BCtrlS As CommandBarButton
     NomLO = LO.Name
     LgnCourante = Selection.Row
    
     If LgnCourante > LO.Range.Row Then
          With Application.CommandBars.Item("List Range Popup")
               .Reset
               idx = 0
               For Each Ctrl In .Controls
                    idx = idx + 1
                    Select Case Ctrl.ID
                         Case 31274
                              Ctrl.Visible = False
                              Set BCtrl = .Controls.Add(Type:=msoControlPopup, Before:=idx, temporary:=True)
                                   With BCtrl
                                        .Caption = ">>>Tableau " & NomLO & " Insérer ligne"
                                        Set BCtrl1 = .Controls.Add(Type:=msoControlButton, temporary:=True)
                                        With BCtrl1
                                             .Caption = "au dessus"
                                             .FaceId = 7373
                                             .OnAction = "InsLigneTS"
                                             .Tag = "Insertion"
                                             .Parameter = NomLO & ";Haut"
                                        End With
                                        If LgnCourante = LO.Range.Row + LO.Range.Rows.Count - 1 Then
                                             Set BCtrl1 = .Controls.Add(Type:=msoControlButton, temporary:=True)
                                             With BCtrl1
                                                  .Caption = "au dessous"
                                                  .FaceId = 12197
                                                  .OnAction = "InsLigneTS"
                                                  .Tag = "Insertion"
                                                  .Parameter = NomLO & ";Bas"
                                             End With
                                        End If
                                   End With
                         Case 31275
                              Ctrl.Visible = False
                              Set BCtrl = .Controls.Add(Type:=msoControlButton, Before:=idx, temporary:=True)
                                   With BCtrl
                                       .Caption = ">>>Tableau " & NomLO & " Supprimer ligne"
                                       .OnAction = "SupLigneTS"
                                       .Tag = "Suppression"
                                       .Parameter = NomLO
                                   End With
                         Case Else
                    End Select
               Next
          End With
     End If
    
End Sub

Sub InsLigneTS()
    
     Dim Btn As CommandBarButton, LO As ListObject, Rg As Range, Wsh As Worksheet
     Dim IdxLgnInser%, i%, NbLgn%
    
     Set Btn = Application.CommandBars.ActionControl
     Paramètres = Split(Btn.Parameter, ";")
     Set LO = Evaluate(Paramètres(0)).ListObject
     Sens = Paramètres(1)
     Set Rg = Selection
     Set Wsh = Rg.Worksheet
     Select Case Sens
          Case "Haut"
               IdxLgnInser = Rg.Row - LO.Range.Row
          Case "Bas"
               IdxLgnInser = Rg.Row - LO.Range.Row + 1
     End Select
     NbLgn = Selection.Rows.Count
    
     Wsh.Unprotect
     For i = 1 To NbLgn
          LO.ListRows.Add IdxLgnInser, True
     Next
     LO.ListRows(IdxLgnInser).Range.Resize(NbLgn).Select
     Wsh.Protect
    
End Sub

Sub SupLigneTS()

     Dim Btn As CommandBarButton, LO As ListObject, Rg As Range, Wsh As Worksheet
     Dim IdxLgnSup%, i%, NbLgn%
    
     Set Btn = Application.CommandBars.ActionControl
     Set LO = Evaluate(Btn.Parameter).ListObject
     Set Rg = Intersect(Selection, LO.Range)
     Set Wsh = Rg.Worksheet
    
     IdxLgnSup% = Rg.Row - LO.Range.Row
     NbLgn = Rg.Rows.Count

     Wsh.Unprotect
     For i = 1 To NbLgn
          LO.ListRows(IdxLgnSup%).Delete
     Next
     Wsh.Protect

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     ReInitMenuContext
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     ReInitMenuContext
     If Me.ProtectContents Then
          If Not Target.Cells(1).ListObject Is Nothing Then
               If InStr(1, TableauxModifiables, "=" & Target.Cells(1).ListObject.Name & "=") > 0 Then
                    ChangeMenuContextListObject Target.Cells(1).ListObject
               End If
          End If
     End If
End Sub

Private Sub Worksheet_Deactivate()
     ReInitMenuContext
End Sub