ListObject (ajout-suppression-modification) et UserForm

[cathodique]

Bonjour,

Beaucoup de personnes disent que les tableaux structurés sont faciles à utiliser. Moi, ils me déroutent surtout en VBA. Merci de m’aider à mieux comprendre cet outil avec le petit projet ci-joint.

1. Je voudrais alimenter la ListBox, tel que dans le fichier avec la notion de ListObject.

2. Avoir une fonction de recherche pour faire ce qui suit :

a) Supprimer l’item sélectionné du tableau et de la listBox

b) Ajouter un item (saisi dans la TextBox) au tableau et mettre à jour la ListBox

c) Lorsqu’un item est sélectionné, en cochant la checkbox, remplacer cet item dans le tableau par le texte saisit dans la textbox et rafraichir la listbox.

Une dernière question, si l’on vide le tableau. Comment insérer des lignes avec ListObject ?
Surtout comment insérer une 1ère ligne juste en-dessous de l'entête?

En vous remerciant par avance.

Bonne journée

 

[bof]

Bonjour,
On va commencer par la dernière question parce qu'elle est fondamentale :
L'inconvénient avec ce genre de table c'est qu'elle n'est valide que lorsqu'il y a au moins une ligne de donnée sinon ça renvoie une erreur. C'est pourquoi il est très difficile (sinon impossible ?) de confectionner des pseudos BD ou des tables non pérennes : Si ce sont des tables ou des BD qu'on doit vider périodiquement (tous les mois ou tous les ans par exemple) et ne laisser que les en-têtes, il est préférables d'utiliser des tableaux classiques et de les définir avec décaler...
A+

 

[cathodique]

Bof bonjour,

Merci pour tes explications. En effet, comme tu me le précises ce genre de tableau (ou table) il faut qu'il ait au moins une ligne de données.
Je me suis rendu compte par code que la dernière ligne non vide n'était pas la bonne, bien que le tableau ait été vidé.
La première ligne du tableau est considérée comme non vide. Et renvoi 3 au lieu de 2, je pense que la seconde est considérée comme contenant une chaîne vide. On peut contourner le problème en faisant ainsi
dl=Range("A" & Rows.Count).End(xlUp).Row -1, et on insère les données sans utiliser le "LisObject"

Mais je n'aurai rien appris sur la manipulation de ces fameux tableaux structurés.
J'ai monté ce fichier dans un but d'apprentissage de manipulation du "ListObject".

Merci à tous les contributeurs par avances.

Bonne journée.

 

[bof]

Re...
Pour les autres questions je me garderai bien d'intervenir car pour ma part, je n'utilise jamais ces ListObject
A+.

 

[BOISGONTIER]

Bonjour,

En BD classique, avec un programme générique ( en qq minutes).

Les 3 lignes adaptées:
Set BD = f.Range("A2:C" & f.[A65000].End(xlUp).Row) ' A adapter (1 colonne de plus)
ColCombo = Array(1,2) ' à adapter (1 à 6 colonnes maxi)
colVisu = Array(1, 2) ' colonnes à visualiser (à adapter)

JB

 

[Lone-wolf]

Bonjour à toutes et à tous

Pour ajouter une ligne au tableau il faut faire comme ceci

Private Sub CmdNouveau_Click()
Dim ListObj As ListObject, i As Long


    Set ListObj = ShInit.ListObjects("TB") 'TB est le nom du tableau
    i = ShInit.Cells(Rows.Count, 1).End(xlUp).Row
    With ListObj
        ShInit.Cells(i, 1) = TextBox1
    End With

        TextBox1 = ""  
        ' On ajoute une ligne vide
        ListObj.ListRows.Add
'Au prochain enregistrement, celui-ci s'inscrira dans la ligne vide et ajoutera une nouvelle ligne.
End Sub

Private sub Maj()
Dim rw As String, i As Long

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For i = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i) = True Then _
  rw = Application.Match(ListBox1.List(0), ShInit.Columns(1), 0)
  Next i

ListBox1.RemoveItem (ListBox1.ListIndex)
'Feuil1.Cells(rw, 1).EntireRow.Delete
Feuil1.Cells(rw, 1) = Textbox1
ListBox1.AddItem TextBox1

End Sub

EDIT: Si doublons dans les prénoms, il faut ajouter une colonne avec les identifiants; exemple: Georges > Geo-01 Marie > Mar-02 etc.

 

[cathodique]

Bonjour,

En BD classique, avec un programme générique en qq minutes.

Set BD = f.Range("A2:C" & f.[A65000].End(xlUp).Row) ' A adapter (1 colonne de plus)
ColCombo = Array(1,2) ' à adapter (1 à 6 colonnes maxi)
colVisu = Array(1, 2) ' colonnes à visualiser (à adapter)

JB

Bonjour JB,

Merci pour l'aide, elle m'est précieuse car je m'inspire beaucoup de tes exemples.
Je voulais juste apprendre à manipuler un peu ces fameux tableaux dits structurés.
On dirait qu'ils n'emballent pas beaucoup de monde en VBA.
J'ai essayé d'alimenter la listbox en utilisant ce listobject sans succès.
Je crois bien que je vais abandonner cette voie et me rabattre sur une bd classique.

Merci beaucoup.

Bonne journée.

 

[cathodique]

Bonjour à toutes et à tous

Pour ajouter une ligne au tableau il faut faire comme ceci

Private Sub CmdNouveau_Click()
Dim ListObj As ListObject, i As Long


    Set ListObj = ShInit.ListObjects("TB") 'TB est le nom du tableau
    i = ShInit.Cells(Rows.Count, 1).End(xlUp).Row
    With ListObj
        ShInit.Cells(i, 1) = TextBox1
    End With

        TextBox1 = ""
        ' On ajoute une ligne vide
        ListObj.ListRows.Add
'Au prochain enregistrement, celui-ci s'inscrira dans la ligne vide et ajoutera une nouvelle ligne.
End Sub

Private sub Maj()
Dim rw As String, i As Long

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For i = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i) = True Then _
  rw = Application.Match(ListBox1.List(0), ShInit.Columns(1), 0)
  Next i

ListBox1.RemoveItem (ListBox1.ListIndex)
'Feuil1.Cells(rw, 1).EntireRow.Delete
Feuil1.Cells(rw, 1) = Textbox1
ListBox1.AddItem TextBox1

End Sub

EDIT: Si doublons dans les prénoms, il faut ajouter une colonne avec les identifiants; exemple: Georges > Geo-01 Marie > Mar-02 etc.

Bonjour Lone-wolf,
Merci, mais ce n'est pas de tes habitudes. Qu'est-ce que tu m'as transmis? Il ne manque rien?!

 

[Lone-wolf]

Re

Dis cath, as-tu vu les codes que j'ai mis??

EDIT: et bien, qu'est-ce que tu veux, il m'arrive parfois des illuminations.

Trève de plaisenteries, sur Internet on trouve les solutions. Il y a quelque temps, j'ai fait un classeur pour créer un tableau. Ci-joint le fichier.

 

[job75]

Bonjour cathodique et les autres,

J'ai essayé d'alimenter la listbox en utilisant ce listobject sans succès.
Je crois bien que je vais abandonner cette voie et me rabattre sur une bd classique.

Les ListObjects sont plus faciles à traiter que les BDD classiques, c'est pour ça qu'ils existent

Pour alimenter la ListBox ceci est archi classique :

Private Sub UserForm_Initialize()
Dim t, d As Object, i&, a
t = Feuil1.ListObjects(1).DataBodyRange.Resize(, 2) 'tableau VBA, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(t)
    If t(i, 2) <> "" Then d(t(i, 2)) = ""
Next
If d.Count = 0 Then Exit Sub
a = d.keys
tri a, 0, UBound(a)
ListBox1.List = a
End Sub

Sub tri(a, gauc, droi)  ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

A+

 

[Lone-wolf]

Bonjour job75

 

[cathodique]

Bonjour Lone-wolf, Job75,

@Lone-wolf : Ah! tu t'en es rendu compte de ce que tu avais mis. Merci pour le fichier, je vais le décortiquer.
Pour la recherche sur le net, soit que tes critères sont très pertinents, soit que je suis archi-nul en recherche.

@job75 : Je n'ai pas encore testé ton code mais je n'en doute pas un instant qu'il ne fonctionne pas.
Merci beaucoup.

1000 mercis, j'apprécie votre aide.

Bonne fin de journée.

 

[BOISGONTIER]

Voici ce que j'ai modifié dans le programme en utilisant la BD Object (rien de révolutionnaire)

'Set BD = f.Range("A2:C" & f.[A65000].End(xlUp).Row) ' A adapter (1 colonne de plus) ' classique
Set BD = f.ListObjects(1).DataBodyRange.Resize(, 3)

'f.Cells(Enreg, 1).Resize(, UBound(TabBD, 2)).Delete Shift:=xlUp 'Classique
f.ListObjects(1).DataBodyRange.Rows(Enreg - 1).Delete

>Comment insérer des lignes avec ListObject ?
Surtout comment insérer une 1ère ligne juste en-dessous de l'entête?

http://boisgontierjacques.free.fr/fichiers/Formulaire/FiltreListboxListObject.xls
http://boisgontierjacques.free.fr/fichiers/Formulaire/FormFiltreListBox6ComboBoxsListObject.xls

Sub InsertLigneDébut()
  Dim f
  Set f = Sheets("bd")
  f.ListObjects(1).ListRows.Add (1)
  f.ListObjects(1).DataBodyRange.Item(1, 1) = "A"
  f.ListObjects(1).DataBodyRange.Item(1, 2) = "Dupont"
End Sub

Sub InsertLigneFin()
  Dim f
  Set f = Sheets("bd")
  f.ListObjects(1).ListRows.Add
  n = f.ListObjects(1).DataBodyRange.Rows.Count
  f.ListObjects(1).DataBodyRange.Item(n, 1) = "B"
  f.ListObjects(1).DataBodyRange.Item(n, 2) = "Durand"
End Sub

JB

 

[Si...]

Bon_soir

Je ne suis pas du genre à proposer des méthodes applicables à tous les cas. Je préfère étudier les situations personnelles (qui demandent des adaptations des précédentes)

[avis personnel]
Je trouve dommage que beaucoup restent sur des acquis sûrs mais sans (faire) profiter des nouveautés apportées au fil des versions. Quand je vois l'évolution quotidienne de notre environnement, je m'abstiens de parler de pérennité.
[/avant d'en changer ?]

Voici un exemple d'utilisation d'un Tableau* étant bien entendu que si la base devient énorme, il vaudra mieux lui associer des tableaux VBA.

* la partie des codes lui incombant est vraiment simple

 

[cathodique]

Voici ce que j'ai modifié dans le programme en utilisant la BD Object (rien de révolutionnaire)

'Set BD = f.Range("A2:C" & f.[A65000].End(xlUp).Row) ' A adapter (1 colonne de plus) ' classique
Set BD = f.ListObjects(1).DataBodyRange.Resize(, 3)

'f.Cells(Enreg, 1).Resize(, UBound(TabBD, 2)).Delete Shift:=xlUp 'Classique
f.ListObjects(1).DataBodyRange.Rows(Enreg - 1).Delete

>Comment insérer des lignes avec ListObject ?
Surtout comment insérer une 1ère ligne juste en-dessous de l'entête?

http://boisgontierjacques.free.fr/fichiers/Formulaire/ListObject.xlsm

Sub InsertLigneDébut()
  Dim f
  Set f = Sheets("bd")
  f.ListObjects(1).ListRows.Add (1)
  f.ListObjects(1).DataBodyRange.Item(1, 1) = "A"
  f.ListObjects(1).DataBodyRange.Item(1, 2) = "Dupont"
End Sub

Sub InsertLigneFin()
  Dim f
  Set f = Sheets("bd")
  f.ListObjects(1).ListRows.Add
  n = f.ListObjects(1).DataBodyRange.Rows.Count
  f.ListObjects(1).DataBodyRange.Item(n, 1) = "B"
  f.ListObjects(1).DataBodyRange.Item(n, 2) = "Durand"
End Sub

JB

Bonsoir JB,
Merci beaucoup pour tout le travail accompli pour répondre à ma demande.
Ma gratitude.
Bonne soirée