XL 2013 Ajout de textboxes sur plusieurs lignes d'un tableau selon la parité de la textbox

Tubule · 23 Juin 2020

Bonjour,

Je cherche à ajouter des textbox issues d'un formulaire dans un tableau. Ces textbox sont numérotées, et je souhaiterais ajouter celles qui sont impaires dans une ligne d'un tableau et celles qui sont paires dans une autre ligne.
J'ai tenté ce code, inspiré de ce forum, mais celui -ci ne fonctionne pas:

VB:

Dim CTRL As Control
    Dim LO As ListObject
    Dim i As Integer, p As Integer
    Dim ligne As Long
    
   ' ligne = Me.Nom_Dossier.ListIndex + 2
    
    Set LO = Sheets("Feuil1").ListObjects("LO_test")
                
    'La variable i va successivement prendre les valeurs 1, 3, 5
With LO.ListRows.Add(AlwaysInsert:=True) 'Ajout d'une ligne dans les charges
    For i = 1 To 7 Step 2 'Juste les impairs
            For Each CTRL In Me.Controls("TextBox" & i) 'Ajout dans les cases du tableau des dates, selon le numéro du tag
                If Len(CTRL.Tag) Then
                    .Range(1, CLng(CTRL.Tag)) = CTRL.Value
                End If
            Next
    Next i
End With
    
    'For p = 2 To 8 'juste les pairs
            
    Me.Hide
    Unload Me
    
End Sub

J'obtiens le message suivant :"membre de méthode ou donnée introuvable" et ".ListIndex" est surligné. Je ne comprends pas ce qui se passe. Auriez-vous une idée ?
Le fichier est joint
Merci

Ananas94 · 24 Juin 2020

Dranreb à dit:

Vous pourriez alors essayer ça :

VB:

Option Explicit
Private LOtDos As ListObject, LOtVal As ListObject, LCou As Long, TVL()
Private Sub UserForm_Initialize()
   Set LOtDos = Feuil1.ListObjects("TabDos")
   Set LOtVal = Feuil1.ListObjects("TabVal")
   ComboBox1.List = LOtDos.DataBodyRange.Value
   End Sub
Private Sub ComboBox1_Change()
   Dim L As Long, C As Long
   If ComboBox1.MatchFound Then
      LCou = ComboBox1.ListIndex + 1
      TVL = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2).Value
   Else
      LCou = 0
      ReDim TVL(1 To 1, 1 To 4)
      End If
   For L = 1 To 2: For C = 2 To 5
      Me("TextBox" & 2 * (C - 2) + L).Text = TVL(L, C)
      Next C, L
   End Sub
Private Sub Validation_Click() 'Bouton Valider
   Dim L As Long, C As Long, V, Rng As Range
   For L = 1 To 2: For C = 2 To 5
      V = Me("TextBox" & 2 * (C - 2) + L).Text
      If IsNumeric(V) Then TVL(L, C) = CDbl(V)
      Next C, L
   If LCou = 0 Then
      LOtDos.ListRows.Add(AlwaysInsert:=True).Range.Value = ComboBox1.Text
      ComboBox1.List = LOtDos.DataBodyRange.Value
      Set Rng = LOtVal.ListRows.Add(AlwaysInsert:=True).Range
      LOtVal.ListRows.Add AlwaysInsert:=True: Set Rng = Rng.Resize(2)
   Else
      Set Rng = LOtVal.ListRows(2 * LCou - 1).Resize(2)
      End If
   Rng.Value = TVL
   End Sub

Merci beaucoup pour votre réponse Dranreb.

Ca a l'air super bien codé, par contre je ne comprends pas tout !
J'obtient le message d'erreur suivant : "L'indice n'appartient pas à la sélection", avec cette ligne surlignée :

VB:

 Me("TextBox" & 2 * (C - 2) + L).Text = TVL(L, C)

Je vous joins le fichier
Auriez-vous une idée ?
Je vous remercie

Dranreb · 24 Juin 2020

Essayez comme ça :

VB:

Option Explicit
Private LOtDos As ListObject, LOtVal As ListObject, LCou As Long, TVL()
Private Sub UserForm_Initialize()
   Set LOtDos = Feuil1.ListObjects("TabDos")
   Set LOtVal = Feuil1.ListObjects("TabVal")
   ComboBox1.List = LOtDos.DataBodyRange.Value
   ReDim TVL(1 To 1, 1 To 4)
   End Sub
Private Sub ComboBox1_Change()
   Dim L As Long, C As Long
   If ComboBox1.MatchFound Then
      LCou = ComboBox1.ListIndex + 1
      TVL = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2).Value
   Else
      LCou = 0
      ReDim TVL(1 To 2, 1 To 4)
      End If
   For L = 1 To 2: For C = 1 To 4
      Me("TextBox" & 2 * (C - 1) + L).Text = TVL(L, C)
      Next C, L
   End Sub
Private Sub Validation_Click() 'Bouton Valider
   Dim L As Long, C As Long, V, Rng As Range
   For L = 1 To 2: For C = 2 To 4
      V = Me("TextBox" & 2 * (C - 1) + L).Text
      If IsNumeric(V) Then TVL(L, C) = CDbl(V)
      Next C, L
   If LCou = 0 Then
      LOtDos.ListRows.Add(AlwaysInsert:=True).Range.Value = ComboBox1.Text
      ComboBox1.List = LOtDos.DataBodyRange.Value
      Set Rng = LOtVal.ListRows.Add(AlwaysInsert:=True).Range
      LOtVal.ListRows.Add AlwaysInsert:=True: Set Rng = Rng.Resize(2)
   Else
      Set Rng = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2)
      End If
   Rng.Value = TVL
   End Sub
Private Sub Retour_Click() 'Pour le bouton Retour
    'Ajout_Dossier.Show 0 'On retourne au formulaire précédent
   Me.Hide
   Unload Me
   End Sub

Ananas94 · 24 Juin 2020

Dranreb à dit:

Essayez comme ça :

VB:

Option Explicit
Private LOtDos As ListObject, LOtVal As ListObject, LCou As Long, TVL()
Private Sub UserForm_Initialize()
   Set LOtDos = Feuil1.ListObjects("TabDos")
   Set LOtVal = Feuil1.ListObjects("TabVal")
   ComboBox1.List = LOtDos.DataBodyRange.Value
   ReDim TVL(1 To 1, 1 To 4)
   End Sub
Private Sub ComboBox1_Change()
   Dim L As Long, C As Long
   If ComboBox1.MatchFound Then
      LCou = ComboBox1.ListIndex + 1
      TVL = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2).Value
   Else
      LCou = 0
      ReDim TVL(1 To 2, 1 To 4)
      End If
   For L = 1 To 2: For C = 1 To 4
      Me("TextBox" & 2 * (C - 1) + L).Text = TVL(L, C)
      Next C, L
   End Sub
Private Sub Validation_Click() 'Bouton Valider
   Dim L As Long, C As Long, V, Rng As Range
   For L = 1 To 2: For C = 2 To 4
      V = Me("TextBox" & 2 * (C - 1) + L).Text
      If IsNumeric(V) Then TVL(L, C) = CDbl(V)
      Next C, L
   If LCou = 0 Then
      LOtDos.ListRows.Add(AlwaysInsert:=True).Range.Value = ComboBox1.Text
      ComboBox1.List = LOtDos.DataBodyRange.Value
      Set Rng = LOtVal.ListRows.Add(AlwaysInsert:=True).Range
      LOtVal.ListRows.Add AlwaysInsert:=True: Set Rng = Rng.Resize(2)
   Else
      Set Rng = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2)
      End If
   Rng.Value = TVL
   End Sub
Private Sub Retour_Click() 'Pour le bouton Retour
    'Ajout_Dossier.Show 0 'On retourne au formulaire précédent
   Me.Hide
   Unload Me
   End Sub

Merci beaucoup ça fonctionne presque ! Sauf que le contenu des TextBoxes 1 et 2 ne s'affichent pas, ce n'est peut-être pas grand chose ..?
Par ailleurs, je viens d’étoffer mon fichier mais je ne parviens pas à adapter le code, car il est vraiment trop compliqué pour moi ..
En effet, je souhaite juste ajouter une liste d'interlocuteurs à côté des dossiers, et à chaque fois indiquer automatiquement dans le tableau 2 rôles différents : pour la première ligne insérée, ça serait "rôle1" (avec les textboxes impaires) et la seconde "role2" (avec les textboxes paires).
je vous joins une proposition que j'ai essayé d'adapter , sans succès. Pouvez-vous me dire ce que vous en pensez s'il vous plaît ?
En tout cas c'est super bien codé, merci et bravo

Dranreb · 24 Juin 2020

Il y a trois colonnes maintenant dans le LOtDos ? Il faut préciser les ListColumn alors !
S'il peut y avoir plusieurs dossiers pour un même interlocuteur je vous conseille l'emploi d'un objet ComboBoxLiées du complément à installer depuis cette ressource.
Sinon il y a encore quelque chose qui ne va pas: il y a un nombre impaire de lignes dans le second tableau alors l'ajout de nouvelles lignes ne se fait pas là où il devrait. Peut être vaudrait-il mieux écrire la Validation_Click comme ça :

VB:

Private Sub Validation_Click() 'Bouton Valider
   Dim L As Long, C As Long, V, Rng As Range
   If LCou = 0 Then
      LOtDos.ListRows.Add(AlwaysInsert:=True).Range.Value = ComboBox1.Text
      ComboBox1.List = LOtDos.DataBodyRange.Value
      LCou = ComboBox1.ListIndex + 1
      While LOtVal.ListRows.Count < 2 * LCou: LOtVal.ListRows.Add AlwaysInsert:=True: Wend
      End If
   Set Rng = LOtVal.ListRows(2 * LCou - 1).Range.Resize(2)
   For L = 1 To 2: For C = 2 To 4
      V = Me("TextBox" & 2 * (C - 1) + L).Text
      If IsNumeric(V) Then TVL(L, C) = CDbl(V)
      Next C, L
   Rng.Value = TVL
   End Sub

Ne pourriez vous vraiment pas faire un seul tableau simple où vous mettez à jour une seule ligne ? Maintenant je sens déjà que vous voulez pouvoir identifier par quelque chose les lignes 1 et 2. Un objet ComboBoxLiées se débrouille pour trouver une ligne correspondant à des critères spécifiés dans plusieurs ComboBox pour différentes colonnes.

Ananas94 · 29 Juin 2020

Bonjour Dranreb,

Merci beaucoup pour votre réponse . Je viens de copier votre code et de le modifier un peu, selon vos indications, à savoir :
1-Création d'un seul tableau
2-Nombre pair de lignes (j'ai indiqué dans le tableau le contenu que je voudrais précisément).

En soit, je pourrais ajouter et mettre à jour une seule ligne, mais j'ai sollicité ce forum pour ajouter deux lignes, car sinon, je saurais faire ! Voilà pourquoi j'insiste un peu
J'ai modifié votre code avec la fusion dans un seul tableau LOtDos. Par ailleurs, j'ai enlevé le tableau TVL, je n'ai pas compris à quoi il servait ; sûrement à lier les données puisque nous avions 2 tableaux ...?)

J'ai regardé les combobox liées ; si j'ai bien compris, cette application est utile lorsque l'on souhaite qu'une combobox soit mise à jour selon une autre combobox modifiée précédemment ; c'est astucieux ! Mais je ne pense pas que ceci soit utile dans mon cas (néanmoins, je serai curieuse de savoir faire !)

Lorsque je tente d'exécuter la macro, le message "L'indice n'appartient pas à la sélection" avec le module "Formulaire.Show 0" surligné en jaune qui apparaît : ainsi, on en peut pas vraiment savoir d'où vient la véritable erreur !
J'ai commenté le code (en pièce jointe) ; pourriez-vous y jeter un oeil s'il vous plaît ?
Merci beaucoup par avance

Dranreb · 29 Juin 2020

Non, TVL servait à accueillir toutes les valeurs de la ligne.
Le ComboBoxLiée permet d'isoler une ligne ou un groupe de lignes ayant en commun les valeurs dans différentes colonnes spécifiées dans plusieurs ComboBox.
Le tableau s'appelle "Tab_Dos" au lieu de "TabDos". Supprimez le "_" dans son nom.
Dans Outils, Options…, Général, Récupération d'erreurs, cochez "Arrêt dans le module de classe"

Ananas94 · 29 Juin 2020

Merci pour votre réponse. Je viens de lire beaucoup de tutos pour les combobox liées, et je viens de faire un essai avec des "projets" hypothétiques, mais je n'y arrive pas... Je pense que mon niveau en VBA est beaucoup trop faible.
Par ailleurs, votre astuce "Arrêt dans le module de classe" est super, car ça me montre bien où est l'erreur ! La ligne suivante est surlignée :

Set Rng = LOtDos.ListRows(2 * LCou - 1).Range.Resize(2)

Je pense que votre code est beaucoup trop complexe pour moi . Qu'est-ce que LCou??!
Je ne comprends pas non plus tout ce paragraphe :

VB:

Set Rng = LOtDos.ListRows(2 * LCou - 1).Range.Resize(2) 'Je ne comprends pas cette ligne
   For L = 1 To 2: For C = 2 To 4
      V = Me("TextBox" & 2 * (C - 1) + L).Text
      If IsNumeric(V) Then TVL(L, C) = CDbl(V)
      Next C, L
   Rng.Value = TVL

Je n'ai pas non plus compris ce paragraphe, dans "Combobox1_Change :

VB:

Else 'Si on ajoute un nouveau dossier
      LCou = 0 'Si on ne trouve pas le nom du dossier , la ligne est la numéro 0 donc la dernière
      ReDim TVL(1 To 2, 1 To 4) 'Redimensionnement ?
      End If
   For L = 1 To 2: For C = 1 To 4
      Me("TextBox" & 2 * (C - 1) + L).Text = TVL(L, C) 'Je n'ai pas compris cette ligne ..?
      Next C, L

Pourriez-vous développer en commentant les lignes s'il vous plaît ?
Vous trouverez le classeur ci-joint...merci

Dranreb · 29 Juin 2020

LCou est généralement le nom que je donne à une variable As Long globale Private destinée à contenir le numéro dans un tableau de la ligne courante en cours de mise à jour.
Set Rng = LOtDos.ListRows(2 * LCou - 1).Range.Resize(2)
définit la variable Rng comme devant représenter la plage couverte par une ligne du tableau dont le numéro est le double de LCou diminué de 1, et rectifié à 2 lignes de haut. J'aime de moins en moins ce système de traitement de 2 lignes à la fois. Je crois que je vais me désabonner de cette discussion.
Ça va être fait tout de suite après cette Édit. Désabonné ! Décidément trop con …

Ananas94 · 30 Juin 2020

Bonjour,
Je vous remercie pour votre réponse et pour votre aide. J'espère que vous n'êtes pas vexé (mais en même temps je ne vois pas pourquoi !??!)
Je vous souhaite une excellente journée.

XL 2013 Ajout de textboxes sur plusieurs lignes d'un tableau selon la parité de la textbox

Tubule

XLDnaute Nouveau

Pièces jointes

Ananas94

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Ananas94

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Ananas94

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Ananas94

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Ananas94

XLDnaute Junior

Discussions similaires