Renvoyer plusieurs attributs liés à une même valeur de textbox

[manolo]

Bonjour à tous,

Je vous explique mon problème du jour :
1) j'ai un userform (userform1)
2) j'ai une base de donnée (sheet1)
3) dans mon userform, j'ai :
- 1 textbox (textbox1) dans lequel je dois rentrer la valeur d'un numéro (situé en colonne 1 de ma base de donnée)
- 4 textboxs (textbox2, textbox3, textbox4, textbox5)
- 1 bouton (valider)

Je souhaite faire la chose suivante :
1) je rentre le numéro dans la textbox1,
2) je clique sur le bouton valider,
3) les 4 textboxs se mettent à jour des attributs correspondant.

Le problème : le nombre d'attribut diffère en fonction des numéros.

En espérant être clair...
Merci de votre aide & bonne journée.
Manolo.

 

[PMO2]

Re : Renvoyer plusieurs attributs liés à une même valeur de textbox

Bonjour,

Le nombre d'attributs pouvant différer il est, à mon avis, préférable d'utiliser une ListBox plutôt qu'une
pléthore de TextBox.
On les supprime toutes.

MARCHE A SUIVRE

1) créez un UserForm1 avec une ListBox1, une ListBox2 et un CommandButton1
2) dans la fenêtre de code du UserForm1 copiez le code suivant

Const MA_BASE As String = "Sheet1"  'à adapter du nom de la feuille de la base de données

Dim var

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim T()
Dim i&
Dim cpt&
For i& = 1 To UBound(var)
  If var(i&, 1) = ListBox1 Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To cpt&)
    T(cpt&) = var(i&, 2)
  End If
Next i&
Me.ListBox2.List = T
End Sub

Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim i&
Dim DICO As Object
Dim T()
Set S = Sheets(MA_BASE)
Set R = S.[A1].CurrentRegion
var = R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count)
Set DICO = CreateObject("Scripting.Dictionary")
For i& = 1 To UBound(var, 1)
  If Not DICO.Exists(var(i&, 1)) Then
    DICO.Add var(i&, 1), var(i&, 1)
    ReDim Preserve T(1 To DICO.Count)
    T(DICO.Count) = var(i&, 1)
  End If
Next i&
Call algoTri(LBound(T), UBound(T), T)
Me.ListBox1.List() = T
End Sub

'**************************
Private Sub algoTri(ByVal limiteinf As Integer, ByVal limitesup As Integer, ByRef tabtri() As Variant)
Dim i%
Dim j%
Dim element
Dim transit
i% = limiteinf
j% = limitesup
transit = tabtri((limiteinf + limitesup) \ 2)
Do
  Do While tabtri(i%) < transit
    i% = i% + 1
  Loop
  Do While transit < tabtri(j%)
    j% = j% - 1
  Loop
  If i% <= j% Then
    element = tabtri(i%)
    tabtri(i%) = tabtri(j%)
    tabtri(j%) = element
    i% = i% + 1
    j% = j% - 1
  End If
Loop Until i% > j%
If limiteinf < j% Then
  Call algoTri(limiteinf, j%, tabtri())
End If
If i% < limitesup Then
  Call algoTri(i%, limitesup, tabtri())
End If
End Sub

A la suite d'un double clic sur un des Numéros, les attributs lui correspondant s'affichent dans la ListBox2.
Ainsi, si une multitude d'attributs est trouvée ils vont tous s'inscrire dans la ListBox2. On n'a plus à se soucier
de gérer le nombre de TextBox.

Cordialement.

PMO
Patrick Morange