XL 2016 Mise à jour d'une ListBox incorrecte dans un UserForm

Guy52

XLDnaute Nouveau
Bonjour,
j'utilise un code créé je crois par Mr Boisgontier.

VB:
Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For I = LBound(mots) To UBound(mots)
        Tbl = Filter(Tbl, mots(I), True, vbTextCompare)
     Next I
     If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For I = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(I), "*")
          For K = 1 To Ncol: b(I + 1, K) = a(K - 1): Next K
        Next I
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     End If

Mais lorsque je cherche lev dans la liste ci-dessous.

Etude géologique et métallogénique de la région de Vabre, Ferrières et Brassac (Tarn)
Etude tectonique et microtectonique comparée de deux domaines hercyniens:
Les nappes de la Montagne Noire (France) et l’Anticlinorium de l’Iglesiense (Sardaigne)
Le Quercy blanc au sud-ouest de Cahors: Aperçu paléogéographique et structural et Ressources du sol.
Le dôme «Orthogneissique» de Montredon-Labessonnié (Tarn) et son enveloppe métamorphique
Le Paléozoïque du Massif de l’Arize (Pyrénées Ariégeoises)
La zone cénomanienne à l’Est de la Vallée du Salat. Etude stratigraphique et structurale
Le volcanisme de l’Ossau (Pyrénées Atlantiques) : pétrologie et analyse structurale
Le massif granitique du Sidobre : pétrographie, structures, relation mise en place cristallisation

Voici le retour qui s'affiche.

1028769


La comparaison du texte ne fonctionne pas car il n'y a aucune thèse dont le sujet comporte ces trois lettres.

Je ne sais pas si une solution existe ?
J'espère avoir respecté la charte de ce Forum car c'est la première fois que je l'utilise.

Cordialement
Guy52
 
Solution
Version avec choix des colonnes à interroger.

VB:
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub UserForm_Initialize()
   Set f = Sheets("THESES")
   ColVisu = Array(1, 2, 3, 4, 5, 6)       ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5)       ' colonnes à interroger
   Set Rng = f.Range("A2:F" & f.[a65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = UBound(ColVisu) + 1
   '-- en têtes de colonne ListBox
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 12
   For Each k In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, k)
     Lab.Top = Y
     Lab.Left = x
     x = x + f.Columns(k).Width * 0.9
     temp = temp & f.Columns(k).Width * 0.9 & ";"
   Next
   temp = Left(temp, Len(temp)...

Guy52

XLDnaute Nouveau
Bonjour Jean-Marie (Chti160),
merci pour ton message d'accueil.
Voici mon fichier qui est en cours de construction.
il s'agit de faciliter la recherche dans la bibliothèque de notre association : l'ASNAT, animée par un certain nombre de bénévoles. Elle contient un certain nombre de thèses et de publications en relation avec les Sciences de la Nature notamment dans le Tarn.

Voici donc le fichier où il n'y a rien de confidentiel.
Je fais actuellement le test sur la recherche de thèses.

Bonne journée
Cordialement,
Guy
 

Pièces jointes

  • BibliothequeLocalAsnat.xlsm.xls
    322.5 KB · Affichages: 10

ChTi160

XLDnaute Barbatruc
Re
Bonjour jacky
je poste quand même Lol
j'avais modifié ainsi :
VB:
If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For I = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(I), "*")
          For K = 1 To Ncol: b(I + 1, K) = a(K - 1): Next K
        Next I
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else 'Ici <====
        Me.ListBox1.Clear ' et là <=====
End If
jean marie
 

Jacky67

XLDnaute Barbatruc
Re
Bonjour jacky
je poste quand même Lol
j'avais modifié ainsi :
VB:
If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For I = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(I), "*")
          For K = 1 To Ncol: b(I + 1, K) = a(K - 1): Next K
        Next I
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else 'Ici <====
        Me.ListBox1.Clear ' et là <=====
End If
jean marie
Bonjour à tous,

Jean -Marie
Oui c'est beaucoup plus mieux :)
Ca m'apprendra à ne pas lire en diagonale :cool:

**En plus c'est confirmé par Maitre Boisgontier
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Version avec choix des colonnes à interroger.

VB:
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub UserForm_Initialize()
   Set f = Sheets("THESES")
   ColVisu = Array(1, 2, 3, 4, 5, 6)       ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5)       ' colonnes à interroger
   Set Rng = f.Range("A2:F" & f.[a65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = UBound(ColVisu) + 1
   '-- en têtes de colonne ListBox
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 12
   For Each k In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, k)
     Lab.Top = Y
     Lab.Left = x
     x = x + f.Columns(k).Width * 0.9
     temp = temp & f.Columns(k).Width * 0.9 & ";"
   Next
   temp = Left(temp, Len(temp) - 1)
   Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
   Me.ListBox1.ColumnWidths = temp
   '---
   ReDim choix(1 To UBound(BD))
   For i = LBound(BD) To UBound(BD)
     For Each k In colInterro
       choix(i) = choix(i) & BD(i, k) & "|"
     Next k
   Next i
   '--- valeurs initiales dans ListBox
   Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol)
   For i = 1 To UBound(BD)
      C = 0
      For Each k In ColVisu
        C = C + 1: Tbl(i, C) = BD(i, k)
      Next k
   Next i
   'TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), 1
   Me.ListBox1.List = Tbl
   Me.Label1.Caption = Me.ListBox1.ListCount & " Ligne(s)"
End Sub

Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For i = LBound(mots) To UBound(mots)
        Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
     If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For i = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(i), "|")
          For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k
        Next i
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else
        Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub

Boisgontier
 

Pièces jointes

  • BibliothequeLocalAsnat.xls
    268.5 KB · Affichages: 9

Guy52

XLDnaute Nouveau
Version avec choix des colonnes à interroger.

VB:
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub UserForm_Initialize()
   Set f = Sheets("THESES")
   ColVisu = Array(1, 2, 3, 4, 5, 6)       ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5)       ' colonnes à interroger
   Set Rng = f.Range("A2:F" & f.[a65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = UBound(ColVisu) + 1
   '-- en têtes de colonne ListBox
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 12
   For Each k In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, k)
     Lab.Top = Y
     Lab.Left = x
     x = x + f.Columns(k).Width * 0.9
     temp = temp & f.Columns(k).Width * 0.9 & ";"
   Next
   temp = Left(temp, Len(temp) - 1)
   Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
   Me.ListBox1.ColumnWidths = temp
   '---
   ReDim choix(1 To UBound(BD))
   For i = LBound(BD) To UBound(BD)
     For Each k In colInterro
       choix(i) = choix(i) & BD(i, k) & "|"
     Next k
   Next i
   '--- valeurs initiales dans ListBox
   Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol)
   For i = 1 To UBound(BD)
      C = 0
      For Each k In ColVisu
        C = C + 1: Tbl(i, C) = BD(i, k)
      Next k
   Next i
   'TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), 1
   Me.ListBox1.List = Tbl
   Me.Label1.Caption = Me.ListBox1.ListCount & " Ligne(s)"
End Sub

Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For i = LBound(mots) To UBound(mots)
        Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
     If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For i = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(i), "|")
          For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k
        Next i
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else
        Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub

Boisgontier
 

Discussions similaires

Réponses
3
Affichages
533

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata