Microsoft 365 Problème de tableau structuré

[CortoXls]

Bonjour à tous
Dans un fichier j'ai un tableau structuré dans chaque onglet soit 12 tableaux nommés Tableau1 à Tableau12
Les onglets sont Feuil1 à Feuil12
Les tableaux contiennent des listes de validation
Les tableaux font 400 lignes
Si j'écris dans la 401 ème ligne, le tableau ne s'agrandit pas et les listes déroulantes ne sont pas reprises.
Est-ce normal ?

 

[CortoXls]

Il y a plusieurs choses bizarres, je trouve (sauf erreur de compréhension de ton code de ma part) :

- Tu commences par déprotéger la feuille et si on est dans la colonne "OK" tu sorts directement de la macro...

- On est donc n'importe où dans la feuille, sauf dans la colonne "OK" du TS, et tu inscris une apostrophe dans la colonne A de la feuille, sous la ligne où on se trouve.

Quel est le but d'aller écrire cette apostrophe ?


[edit]
Ah, tu as modifié ton message, du coup ça amène une autre question. 😉
- Dans EvolTbl tu parles de double-clic, mais EvolTbl est appelée dans Worksheet_Change.

Mais bon, sans classeur on cause un peu dans le vide. 🙁
[/edit]

La colonne k sert à d'autres fonctionnalités liées au double-click dans cette colonne ( consolidation de la saisie après contrôle Qualité) donc je ne la prends pas en compte
L'apostrophe permet de rajouter une ligne dans le tableau, sous la ligne en cours de saisie.

 

[TooFatBoy]

Si je comprends bien ta réponse, les problèmes que j'ai mentionnés n'en sont pas pour toi.
Et le fait que la feuille reste déprotégée est également normal ?

 

[CortoXls]

Si je comprends bien ta réponse, les problèmes que j'ai mentionnés n'en sont pas pour toi.
Et le fait que la feuille reste déprotégée est également normal ?

Je la re-protege avec le dernier appel

 

[TooFatBoy]

Bon, puisque toutes ces erreurs sont normales, c'est parfait. 👍


Bonne journée
🖖

 

[Phil69970]

Perso sans fichier je n'irais pas plus loin et comme le dit TFB
De plus vouloir refaire une roue ... (carrée) ......... c'est pas pour moi.

sans classeur on cause un peu dans le vide. 🙁

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @CortoXls
Bonjour @Phil69970 , @TooFatBoy , @chris , @cathodique
J'avais consulté ce fil alors qu'il n'avait encore pas trop évolué puis je me suis déconnecté pour proposé une solution qui imite le menu contextuel des tableaux structurés (j'avais déjà fait cela dans le passé). Alors un peu comme d'habitude je propose quand même ce que j'ai fait.
Le Clic Droit dans un TS va dépendre de plusieurs choses :

• la feuille est non protégée : on ne change rien
• La feuille est protégée
  • Le TS fait parti de la liste des tableaux éditables (dans une constante de chaîne type "=TS1=TS2="
    • On adapte le menu contextuel
  • Il ne fait pas partie de ces TS
    • on ne change rien.

Ça a le mérite de ne pas trop changé les habitudes des utilisateurs.

Voici les codes mis en place
(Sh_AvecTS le CodeName de la feuille concernée)
Les constantes

Public Const TableauxModifiables = "=TS_Actif1=TS_Actif2="

L'adaptation du menu contextuel

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

Les macros d'insertion / suppression

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

Les événements de la feuille Sh_AvecTS

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

Voir la pièce jointe

À bientôt

 

[CortoXls]

Perso sans fichier je n'irais pas plus loin et comme le dit TFB
De plus vouloir refaire une roue ... (carrée) ......... c'est pas pour moi.

Le fichier ne m'appartient pas...
Je ne l'aurais certainement pas fait tel qu'il est !!!

J'ai juste eu la demande initiale : pourquoi le tableau ne s'agrandit pas et donc pourquoi les listes déroulantes n'apparaissent pas...
J'ai eu la réponse : feuille protégée !
Par curiosité j'ai cherché et demandé une solution. Je vais la présenter et elle sera peut-être intégrée. Il ne s'agit donc pas d'une roue carrée ni d'erreurs...
@AtTheOne : je vais étudier ta solution qui me semble très intéressante et à priori beaucoup plus solide que la mienne !!! J'aurais sans doute des questions pour bien comprendre le code qui est bien plus élaboré que le mien.
Merci à tous pour votre participation et vos solutions !

 

[Phil69970]

@CortoXls

Le fichier ne m'appartient pas...

Rien ne t’empêche de fournir un fichier représentatif

C'est quoi représentatif ?

- représentatif, même organisation des lignes et des colonnes, mêmes libellés, même nom des TS, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ... remplacé par Nom1, Nom2 etc ....
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables (Avec le résultat souhaité éventuellement)

Si cela fonctionne sur le fichier fourni et pas sur le vrai fichier c'est qu'il n'est en rien représentatif ou que tu n'as pas su transposer ce qui devrait être un simple copier coller du code.

Bonne lecture

 

[chris]

Bonjour à tous
J'avais publié une solution ici https://excel-downloads.com/threads/vba-executer-la-validation-de-cellule.20011925/#post-20091293

Elle prévoit de nombreux cas.
Un onglet précise la logique.

 

[TooFatBoy]

Par curiosité j'ai cherché et demandé une solution. Je vais la présenter et elle sera peut-être intégrée. Il ne s'agit donc pas d'une roue carrée ni d'erreurs...

La roue est malheureusement bien carrée dans le code que tu proposes avec l'écriture d'une apostrophe pour ajouter une ligne.
Et il y a malheureusement aussi des erreurs de logique comme celles que j'ai signalées.

Surtout que Phil t'a donné la solution dès le message #5. 😉