Listbox et Columncount - ColumnWidths

[juliette]

Bonjour le forum...

c'est l'heure du déjeuner mais je me retrouve fasse à un problème qui me contraint à sauter ce repas... hihi, je sais c'est pas bien mais Excel quand tu nous tiens... lol

je vous présente mon pb.

dans l'une des multiples exquises démo de notre ami Thierry, j'ai récupérer un code me permettant notamment de renseigner dans une listbox des données obtenues grâce à une recherche effectuée dans une database txt préalablement sélectionnée...

pour les amateurs, la démo est : "Thierry's search engine v02"
(je ne me souviens plus du file)

les données souhaitées apparaisent bien dans la listbox cependant, les informations ne sont séparées que d'un espace ou un quelconque caractère.
La listbox se présente alors ainsi:

Pierre informaticien 10 ans
Frédérique pharmacienne 8 ans
Eric SP 2 mois
...

Je souhaite en fait aligner les informations sous forme de 3 colonnes.


Voici le code de Thierry:

"Private Sub CmdOKStandard()
Dim Cell As Range
Dim StringSearch As String
Dim FirstAddress As String
Dim Item

CleanStringFound

F = 0: x = 0: Total = 0

If Me.LblTXTSelected = "Selection" Or OpenFile = "" Then
Me.MultiPage1.Value = 1
Me.LblRed.Visible = True
Exit Sub
End If


With Me
StringSearch = .TxBString
If StringSearch = "" Then: .TxBString = "Cannot Be Empty": Exit Sub
End With


With USF1
.LbxString.Clear
.LblRecords = ""
.LblScan = ""
End With

With Range(RangeSearch)
Set Cell = .Find(StringSearch, LookIn:=xlValues, lookat:=xlPart)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
x = x + 1
Me.LblScan = "Scanning " & x & " records"

If Me.OpbNick = True Then
On Error Resume Next
StringFound.Add Cell.Offset(0, -ColOffset).Text & "# : " & Cell.Text & " | :" & Cell.Offset(0, 1).Text, _
Cell.Offset(0, -ColOffset).Text & "# : " & Cell.Text & "| :" & Cell.Offset(0, 1).Text
Else
On Error Resume Next
StringFound.Add Cell.Offset(0, -ColOffset).Text & "# : " & Cell.Text, _
Cell.Offset(0, -ColOffset).Text & "# : " & Cell.Text
End If

DoEvents
Me.LblRecords = "Reccords " & x
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
End If
End With

If x = 0 Then Me.LblRecords = "No Item found": Exit Sub

For Each Item In StringFound
With USF1
.LbxString.AddItem Item
F = F + 1
End With
Next

With USF1
.LblScan = "Filtered Records " & F
End With

If F > 0 Then
With Me
.LblFineSearch.Visible = True
.TxbFineString.Visible = True
.CmdFineSearch.Visible = True
.TxbFineString.SetFocus
End With
End If


End Sub"


je n'ai pas réussi à y intégrer les notion de "ColumnCount " et de "ColumnWidths".

Merci d'avance pour votre éventuelle aide.

Juliette

 

[@+Thierry]

Bonjour Juliette, le Forum

Je ne pense pas que tu t'y prennes correctement, en effet c'est bien plus compliqué d'essayer d'adapter coûte que coûte une démo existante et construite pour un cas précis (ici en l'occurrrence un moteur de recherche sur ce forum).

Non et comme il m'arrive souvent de le dire dans ce forum, là c'est plus long de trafiquer ce code que de le refaire ! Donc on laisse tomber car de plus je pense que celà n'a rien à voir avec tes besoins.

Non en attendant pour que quelqu'un puisse t'aider dis nous en plus sur ton Txt, si il n'y a que des espaces en séparateur (ou autre) etc... toute information utile...

Sorry et Bon Aprèm
@+Thierry

 

[juliette]

Bonjour Thierry et le Forum...

Tout d'abord, je te remercie de t'être "arrêté" quelques instants sur mon file.

Je partage tout ce que tu dis et qu'il sera peut-être plus "simple" de tout reconstruire.

en fait, c'est en effectuant une recherche sur le forum pour mon besoin que je suis tombé sur ton impressionnante démo.

je vais te présenter mon besoin:

Ce que je possède:
- 3 bases de données XLS (saison 2001 - saison 2002 - saison 2003)
- ces bases possèdent chacune 10 colonnes (nom, prénom, date de naissance, catégorie, nb de match....)

Ce que je souhaiterai faire:
- à partir d'un userform, sélectionner une base de donnée, sélectionner un critère de recherche (nom ou catégorie) et taper la chaine de caractère recherchée dans ce qui s'apparente à un moteur de recherche.

- afficher les résultats dans une listbox sous forme de colonne

-(éventuellement affiner la recherche)

- extraire les données de cette listbox dans un classeur excel.


Présenté comme ça, ça n'a pas l'air compliqué lol


Peut-être as-tu déjà rencontré ce type de demande...

en tout cas, je remercie par avance quiconque pourrait m'aider.
et encore une fois, bravo Thierry pour ce que tu apportes au Forum et bravo à toutes et à tous de le faire vivre!

Juliette

 

[@+Thierry]

Bonjour Juliette, le Forum

Euh, oui mais disons que tu t'attaques à vraiment un gros morceau, d'ailleurs le programme :

Ce lien n'existe plus

et ses bases de données :
Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

N'était pas une démo, mais un utilitaire pour le Forum XLD...

Mais bon, là je ne peux vraiment pas remettre çà pour une demande perso... Je ne sais pas si tu t'imagines, mais il y a des heures de boulot.

Ce que je peux faire, mais tout dépendra de tes compétances, c'est de te mettre sur la voie pour "trafiquer" ce UserForm ... (mais bon faudra t'accrocher ! lol)

Bon alors remplace la Procédure complète Suivante :
Private Sub CmdOKStandard()
Dim Cell As Range
Dim StringSearch As String
Dim FirstAddress As String
Dim Item

'AJOUT DE VARIABLE POUR JULIETTE
Dim Container As Variant
Dim Tabcontainer() As String
Dim Y As Long
'FIN d'AJOUT DE VARIABLE POUR JULIETTE

CleanStringFound

F = 0: x = 0: Total = 0

If Me.LblTXTSelected = "Selection" Or OpenFile = "" Then
Me.MultiPage1.Value = 1
Me.LblRed.Visible = True
Exit Sub
End If


With Me
StringSearch = .TxBString
If StringSearch = "" Then: .TxBString = "Cannot Be Empty": Exit Sub
End With


With USF1
.LbxString.Clear
.LblRecords = ""
.LblScan = ""
End With

With Range(RangeSearch)
Set Cell = .Find(StringSearch, LookIn:=xlValues, lookat:=xlPart)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
x = x + 1
Me.LblScan = "Scanning " & x & " records"
'SIMPLICATION DU CODE POUR JULIETTE SANS OPTION OpbNick

On Error Resume Next
StringFound.Add Cell.Offset(0, -ColOffset).Text & "#" & Cell.Text & "#" & Cell.Offset(0, -1).Text, _
Cell.Offset(0, -ColOffset).Text & "#" & Cell.Text & "#" & Cell.Offset(0, -1).Text

DoEvents
Me.LblRecords = "Reccords " & x
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
End If
End With

If x = 0 Then Me.LblRecords = "No Item found": Exit Sub


'PARTIE MODIFIE POUR JULIETTE
For Each Item In StringFound
Container = Split(Item, "#")
ReDim Preserve Tabcontainer(3, Y)
Tabcontainer(0, Y) = Container(0)
Tabcontainer(1, Y) = Container(1)
Tabcontainer(2, Y) = Container(2)
Y = Y + 1
Next

With USF1
With .LbxString
.ColumnCount = 3
.ColumnWidths = "50;250;80"
End With

For Y = 0 To UBound(Tabcontainer, 2)
With .LbxString
.AddItem Tabcontainer(0, Y)
.Column(1, Y) = Tabcontainer(1, Y)
.Column(2, Y) = Tabcontainer(2, Y)
End With
F = F + 1
Next
End With
'FIN DE MODIFICATION POUR JULIETTE

With USF1
.LblScan = "Filtered Records " & F
End With

If F > 0 Then
With Me
.LblFineSearch.Visible = True
.TxbFineString.Visible = True
.CmdFineSearch.Visible = True
.TxbFineString.SetFocus
End With
End If
End Sub

Tu devrais avoir tes Items séparés dans trois colonnes... Je viens de tester jusque là çà fonctionne... Mais bon, ne t'avise pas de souhaiter que le reste fonctionne sans embrouille, déjà le Click sur la listBox peut être définitivement supprimé, et sûrement pas mal d'autres trucs...

Pour renvoyer tes items dans une feuille il suffira d'un bouton de plus avec ce code :

Private Sub CommandButton2_Click()
Dim i As Long

Worksheets.Add
With ActiveSheet

For i = 0 To Me.LbxString.ListCount - 1
.Cells(i + 1, 1) = Me.LbxString.List(i, 0)
.Cells(i + 1, 2) = Me.LbxString.List(i, 1)
.Cells(i + 1, 3) = Me.LbxString.List(i, 2)
Next
End With

End Sub

(Refaire idem pour le CmdFineSearch_Click si besoin)

Voilà grosse modo, le topo, mais attention il y a du boulot d'adaptation... Car ta demande est pratiquement aussi compliquée que ce UserForm mais en étant différente tout de même....

Sinon en plus simple tu as aussi cette démo :

=> Fichier Téléchargeable Lien supprimé

Où en fait il te suffirait d'importer les TXT dans les feuilles avant de faire tourner ce UserForm

Bon Courage en tout cas et merci des compliments
@+Thierry

 

[juliette]

Bonjour Thierry et le Forum...

Que dire? par quoi commencer?

Je suis en admiration devant les choses fascinantes que tu réalises... et je suis loin d'être la seule à penser sincèrement les compliments qui te sont destinés.

au nom de tous (là, je les sens derrière moi lol), encore bravo et merci!

Je mesure à chaque fois le travail titanesque que tu réalises et c'est avec une certaine retenue que je me permets de "t'emprunter" ce que tu nous offres...
Et c'est pourquoi que bien au-delà du simple "copier-coller", j'essaie, tant bien que mal, de te suivre (t'as bcp trop d'avance mais je suis jeune et j'ai bcp d'espoir lol) et de comprendre comment tu as fait pour réaliser ces petites merveilles (souvent c'est pas gagné!!!).
C'est grâce à toi, mais aussi à Ti, Pascal76, Celeda, Monique, Salim, Jean-Marie, André, C@thy,... j'en passe et pas des moins compétents, que j'ai pu progresser.


Pour revenir, au code que tu as spécialement modifié pour moi, je l'ai appliqué tel quel et rien à dire ça marche comme sur des roulettes!
tu as exactement répondu à mon besoin... qui est bien moins ambitieux que l'utilitaire que tu as réalisé.
en effet, je me "limite" au userform1 et je n'utilise pas le double click ds la listbox ni les fonctionnalités que cela génère. Je n'utilise pas non plus la partie "thread".

Aussi, j'ai essayé de modifier le code concernant le "CmdFineSearch_Click" mais sans succès.
j'ai trituré cela dans tous les sens mais mes compétences ne me permettent pas encore de résoudre les obstacles rencontrés...

Après le coup de main (pour ne pas dire plus!), as-tu -encore- la gentillesse de me donner un coup de pouce?

1000 merci

Juliette

 

[@+Thierry]

Re Bonjour Juliette, le Forum, mes Admiratrices et Admirateurs (lol)

Par contre je ne pense pas que tu me suives suffisamment car les modifs étaient excatement les mêmes pour le "CmdFineSearch_Click"

Voici le "patch" donc !

Private Sub CmdFineSearch_Click()
Dim FineStringFound As New Collection
Dim Item As Variant, FineSearch As Variant
Dim F As Integer
'VARIABLES ADDITIONNELLES POUR JULIETTES
Dim Container As Variant
Dim Tabcontainer() As String
Dim Y As Integer

For Each Item In StringFound
On Error Resume Next
FineSearch = Application.WorksheetFunction.Search(Me.TxbFineString, Item)
If FineSearch <> "" Then
FineStringFound.Add Item, Item
End If
FineSearch = ""
Next
USF1.LbxString.Clear

'PARTIE MODIFIEE POUR JULIETTE
For Each Item In FineStringFound
Container = Split(Item, "#")
ReDim Preserve Tabcontainer(3, Y)
Tabcontainer(0, Y) = Container(0)
Tabcontainer(1, Y) = Container(1)
Tabcontainer(2, Y) = Container(2)
Y = Y + 1
Next

With USF1
For Y = 0 To UBound(Tabcontainer, 2)
With .LbxString
.AddItem Tabcontainer(0, Y)
.Column(1, Y) = Tabcontainer(1, Y)
.Column(2, Y) = Tabcontainer(2, Y)
End With
F = F + 1
Next
End With
'FIN DE PARTIE MODIFIEE POUR JULIETTE


If F = 0 Then
Me.LblScan = "No Item found"
Else
Me.LblScan = "Filtered Records " & F
End If
End Sub

Bon Après Midi, (PS je n'ai pas testé car j'ai qu'une main, avec l'autre je mange un Sandwich ! )

@+Thierry

 

[juliette]

Hello Thierry et THE Forum!

après une mini-absence dû à un acharnement de ma part sur un code, je viens t'annoncer que celui que tu n'as pu tester pour cause de pause sandwich bien méritée fonctionne à merveille.
en fait, dans mes tentatives, je n'avais pas réussi à placer correctement la partie que tu as modifiée pour moi...

"j'en ai rêvé, Thierry l'a fait!" lol... (j'ai déjà vu ce slogan quelque part?!)

pour revenir à mon absence, j'ai tenté de rajouter un morceau de code me permettant de fournir dans un label la somme des valeurs se trouvant dans la 3ème colonne de la listbox... mais sans succès!

j'ai essayé d'adapter (c'est tout ce que je sais faire pour l'instant) un code découvert sur le forum mais ça n'a pas marché.
c'est un code à toi (inutile de le préciser... lol) que tu avais fourni dans ce fil:


http://www.excel-downloads.com/html/French/forum/messages/1_107955_107955.htm


comment puis-je l'adapter à mon besoin pour obtenir comme ce que tu as fait la somme des valeurs dans un label?
si tu as le temps et l'envie de m'aiguiller, je suis toute ouie...

merci encore

Juliette

 

[@+Thierry]

Bonsoir Juliette, le Forum

Heuh, oui bon alors le prochain post tu m'appelles Roméo, sinon je ne finis pas ton application ! lol

Ben là ce que tu demandes n'est pas prévu... Ni par Roméo ni par moi !

Car ta base de données Txt (e.g. "Frédérique pharmacienne 8 ans") ne contient pas ce qu'il faut...

Donc tu dois avoir une quatrième zone à additionner.... Dons tu transformes la construction de la Dynamic Array "Tabcontainer" avec une quatrième colonne tout en ayant pris soin au préalable de construire aussi la Collection "StringFound" en conséquence, sans avoir omis la dématériallisation indispensable de cette "StringFound" en quatrième zone par le Split dans le Container... Une fois que tu auras fait ceci... le reste est tout simple :

For Y = 0 To UBound(Tabcontainer, 2)
With .LbxString
.AddItem Tabcontainer(0, Y)
.Column(1, Y) = Tabcontainer(1, Y)
.Column(2, Y) = Tabcontainer(2, Y)
MySum = MySum + Tabcontainer(3, Y)
End With
F = F + 1
Next
End With

Me.LeLabelDuSousTotal.Caption = MySum

(En ayant pris soin aussi de déclarer MySum As Double...)

Bon Amusement, si tu n'y arrives pas, postes au moins le code de ce que tu auras tenté, je me sentirais moins seul en bas du dongeon !! lol

Bonne Nuit
@+Thierry