XL 2019 Modification de données dans Listbox

Monhtc

XLDnaute Occasionnel
Bonjour le forum. Je galère sur mon code et c'est avec vous que j'espère trouver solution
Je souhaite afficher toutes les données de la ligne sélectionnée de ma Listbox "bdd" dans les combobox et textbox respectifs pour modification si nécessaire.
 

Pièces jointes

  • APPLY.xlsm
    36.1 KB · Affichages: 13

Paf

XLDnaute Barbatruc
Bonjour,

supprimer le code contenu dans Private Sub bdd_Click() et remplacer par :

VB:
With bdd
 benef.Text = .List(.ListIndex, 0)
 '.......compléter pour les autres textbox et combobox
End With

.List(.ListIndex, 0) donne le premier champ d'une ligne de la listbox
.List(.ListIndex, 1) donne le deuxième champ d'une ligne de la listbox
etc ...

A+
 

Monhtc

XLDnaute Occasionnel
Bonjour,

supprimer le code contenu dans Private Sub bdd_Click() et remplacer par :

VB:
With bdd
benef.Text = .List(.ListIndex, 0)
'.......compléter pour les autres textbox et combobox
End With

.List(.ListIndex, 0) donne le premier champ d'une ligne de la listbox
.List(.ListIndex, 1) donne le deuxième champ d'une ligne de la listbox
etc ...

A+
Merci @Paf de t'etre penché sur mon code. j'ai essayé le code qui suit conformément à ton instruction mais ca cale. je me suis peut etre planté quelques part
VB:
Private Sub bdd_Click()
With bdd
benef.Text = .List(.ListIndex, 0)
recept.Text = .List(.ListIndex, 1)
numfact.Text = .List(.ListIndex, 2)
dfact.Text = .List(.ListIndex, 3)
montant.Text = .List(.ListIndex, 4)
piece.Text = .List(.ListIndex, 5)
dcf.Text = .List(.ListIndex, 6)
rcf.Text = .List(.ListIndex, 7)
dac.Text = .List(.ListIndex, 8)
dpaid.Text = .List(.ListIndex, 9)
End With
End Sub
 

Paf

XLDnaute Barbatruc
.List(.ListIndex, 0)= premier champ ligne de la listbox (= colonne A de la feuille)
.List(.ListIndex, 1)= deuxième champ ligne de la listbox (= colonne B de la feuille)
...
.List(.ListIndex, 9)= ligne de la listbox (= colonne J de la feuille)

Pour pouvoir afficher le neuvième champ, il faudrait que la colonne J ait été chargée dans la Listbox

Voir dans Private Sub UserForm_Initialize() :
VB:
bdd.RowSource = "Feuil1!A1:I65356"
et modifier

A+
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonsoir,

Je te propose le programme ci joint avec recherche intuitive sur la première colonne.
On peut supprimer ou ajouter des champs dans le tableau structuré.

Sans titre.png


VB:
Option Compare Text
Dim nomTableau, TblBD(), nbCol
Private Sub UserForm_Initialize()
nomTableau = "Tableau1"
nbCol = Range(nomTableau).Columns.Count
TblBD = Range(nomTableau).Resize(, nbCol + 1).Value              ' Array: + rapide
For i = 1 To UBound(TblBD): TblBD(i, nbCol + 1) = i: Next i      ' No enregistrement
LabelsTextBox
TextBoxRecherche_Change
End Sub

Private Sub TextBoxRecherche_Change()
  colRecherche = 1
  colRecherche2 = 2
  clé = Me.TextBoxRecherche & "*": n = 0
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Or TblBD(i, colRecherche2) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To 3, 1 To n)
        Tbl(1, n) = TblBD(i, colRecherche): Tbl(2, n) = TblBD(i, colRecherche2)
        Tbl(3, n) = TblBD(i, nbCol + 1)
     End If
  Next i
  If n > 0 Then Me.Listbox1.Column = Tbl Else Me.Listbox1.Clear
End Sub

Private Sub Listbox1_Click()
  ligneEnreg = Me.Listbox1.Column(2)
  Me.Enreg = ligneEnreg
  For k = 1 To nbCol
    Me("textbox" & k) = TblBD(ligneEnreg, k)
  Next k
End Sub

Sub LabelsTextBox()
   For c = 1 To nbCol
      Me("textbox" & c).Width = Range(nomTableau).Columns(c).Width * 1.3
      tmp = Range(nomTableau).Offset(-1).Item(1, c)
      Me("label" & c).Caption = tmp
      lg = Len(tmp): If Len(tmp) > 20 Then lg = 20
      Me("label" & c).Width = lg * 8
   Next
End Sub

Sub raz()
    For k = 1 To nbCol
      Me("textBox" & k) = ""
    Next k
    Me.TextBox1.SetFocus
End Sub

Private Sub B_sup_Click()
If Me.Enreg <> "" Then
  If MsgBox("Etes vous sûr de supprimer " & Me.TextBox1 & "?", vbYesNo) = vbYes Then
    Range(nomTableau).Rows(Me.Enreg).Delete
    Me.Enreg = ""
    UserForm_Initialize
    raz
    Me.Enreg = Range(nomTableau).Rows.Count + 1
  End If
End If
End Sub

Private Sub B_ajout_Click()
    raz
    Me.Enreg = Range(nomTableau).Rows.Count + 1
End Sub
Private Sub B_validation_Click()
  Enreg = Me.Enreg
  For c = 1 To nbCol
   If Not Range(nomTableau).Item(Enreg, c).HasFormula Then
     tmp = Me("textbox" & c)
     If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
        tmp = Replace(tmp, ".", ",")
        Range(nomTableau).Item(Enreg, c) = CDbl(tmp)
     Else
         If IsDate(tmp) Then
           Range(nomTableau).Item(Enreg, c) = CDate(tmp)
         Else
           Range(nomTableau).Item(Enreg, c) = tmp
         End If
     End If
    Else
     Range(nomTableau).Item(Enreg - 1, c).Copy
     Range(nomTableau).Item(Enreg, c).PasteSpecial Paste:=xlPasteFormats
    End If
  Next c
  UserForm_Initialize
  raz
End Sub

Private Sub B_précédent_Click()
If Me.Listbox1.ListIndex > 0 Then
    Me.Listbox1.ListIndex = Me.Listbox1.ListIndex - 1
End If
End Sub

Private Sub B_suivant_Click()
If Me.Listbox1.ListIndex < Me.Listbox1.ListCount - 1 Then
    Me.Listbox1.ListIndex = Me.Listbox1.ListIndex + 1
End If
End Sub


Boisgontier
 

Pièces jointes

  • Copie de TextBoxCherche-1.xlsm
    59.9 KB · Affichages: 25
Dernière édition: