VBA - résultat Listbox à partir d'une TextBox

Version imprimable

15/03/2023, 18h05
marionmlt

1 pièce(s) jointe(s)

VBA - résultat Listbox à partir d'une TextBox

Bonjour à tous,

On m'a demandé de faire une sorte de base de données qui répertorie des comptes rendus afin de pouvoir faire une recherche par mot clés et savoir quand est-ce que tel ou tel sujet a été abordé.

j'ai commencé quelque chose (un bon début) mais je bloque ensuite.
Pièce jointe 635848

voila ce que j'avais envie de faire :
dans le Textbox1 > taper un mot clé qui sera cherché dans la colonne C et éventuellement aussi dans la colonne D

Dans le Listbox1 > j'aimerai que les résultats affichent les colonnes D et E correspondantes
'et c'est la où je bloque car la listbox m'affiche uniquement les termes inscrit dans le textbox1

le must du must (la cerise sur le gâteau) serait de pouvoir
en cliquant sur cmbbtn1 accéder au fichier qui est mis en lien dans la colonne F
avoir un tri alphabétique de la listbox

Je vous remercie grandement pour ce que vous pourrez faire pour moi ! :)

à bientôt

1 pièce(s) jointe(s)

Bonjour

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub txtbox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(Me.txtbox1) = 0 Then
Me.ListBox1.RowSource = ""
Exit Sub
Else:
Call Recherche
On Error GoTo ErrorHandler
Me.ListBox1.RowSource = "Base"
ErrorHandler:
Exit Sub
End If
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Recherche()
Dim Zone As Range
Dim Critere
Dim Destination As Range
Dim DL 'La dernière ligne du tableau puisqu'elle est variable
DL = Feuil3.Range("A" & Rows.Count).End(xlUp).Row
 
'Mon critère est saisi dans le txtbox1. _
Il doit aussi être sur la feuille source des données pour que le filtre puisse se faire
 
Feuil3.Range("J2") = "mots-clés secondaires"
Feuil3.Range("J3") = Me.txtbox1.Value 'Pour renseigner la plage critère
 
'Affectation des variables
 
Set Zone = Feuil3.Range("A1:F" & DL)
Set Critere = Feuil3.Range("J2:J3")
Set Destination = Feuil1.Range("A1")
 
'On efface l'ancienne exportation
Feuil1.Cells.ClearContents
On Error GoTo ErrorHandler
'On lance l'outils FiltreAvancé
Zone.AdvancedFilter xlFilterCopy, Critere, Destination
ErrorHandler:
Exit Sub
End Sub

1 pièce(s) jointe(s)

Citation:

Envoyé par marionmlt

Dans le Listbox1 > j'aimerai que les résultats affichent les colonnes D et E correspondantes
'et c'est la où je bloque car la listbox m'affiche uniquement les termes inscrit dans le textbox1

Bonjour
Tu peux utiliser la propriété ColumnWidths ( 0 pt;100 pt;139,95 pt;270 pt;70 pt;0 pt) de la Listbox1 pour redimensionner les colonnes et attribuer la valeur 0 pour masquer une colonne
Pour trier par ordre alphabétique, appelle cette fonction après la recherche.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Trie_Resultats() 'Trie décroissant de la liste des paiements Dim DLt As Long DLt = Feuil1.Range("A" & Rows.Count).End(xlUp).Row Feuil1.Sort.SortFields.Clear Feuil1.Sort.SortFields.Add2 Key:=Range("C2:C" & DLt) _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With Feuil1.Sort .SetRange Range("A1:F" & DLt) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .Apply End With Range("A1").Select End Sub
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 Sub Recherche() Dim Zone As Range Dim Critere Dim Destination As Range Dim DL 'La dernière ligne du tableau puisqu'elle est variable DL = Feuil3.Range("A" & Rows.Count).End(xlUp).Row 'Mon critère est saisi dans le txtbox1. _ Il doit aussi être sur la feuille source des données pour que le filtre puisse se faire Feuil3.Range("J2") = "mots-clés secondaires" Feuil3.Range("J3") = Me.txtbox1.Value 'Pour renseigner la plage critère 'Affectation des variables Set Zone = Feuil3.Range("A1:F" & DL) Set Critere = Feuil3.Range("J2:J3") Set Destination = Feuil1.Range("A1") 'On efface l'ancienne exportation Feuil1.Cells.ClearContents On Error GoTo ErrorHandler 'On lance l'outils FiltreAvancé Zone.AdvancedFilter xlFilterCopy, Critere, Destination 'Trie alphabétique de la colonne C Call Trie_Resultats ErrorHandler: Exit Sub End Sub
Pour avoir le résultat de la recherche immédiatement en saisissant, j’ai remplacé
Code:

1 2 3 Private Sub txtbox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) End Sub
Par
Code:

1 2 3 Private Sub txtbox1_Change() End Sub
Citation:

Envoyé par marionmlt

en cliquant sur cmbbtn1 accéder au fichier qui est mis en lien dans la colonne F

Je reviens pour cette partie concernant les fichiers avec cmbbtn1

Je joins la version 2 du fichier

21/03/2023, 09h06
marionmlt

Merci

Bonjour Niagala,

Je vous remercie grandement, ça se rapproche bien de ce que je souhaitais faire ! :)
Vous êtes un génie!

1 pièce(s) jointe(s)

Bonjour
Maintenant pour la gestion des fichiers PDF, il faut les ajouter au préalable ensuite les afficher.
Pour cela, on ajoute deux boutons : « Ajouter un fichier PDF » et « Afficher le PDF »
Au niveau du bouton « Ajouter un fichier PDF »

Code:

1
2
3
4
5
6
7
8
9
'1- AJOUTER OU MODIFIER DES FICHIERS PDF
'2- Vérifier si un enregistrement possède déjà un fichier PDF
Public Function FichierExiste(MonFichier As String)
If Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Ajout_Pdf_Click()
Dim PDFLocation As String
Dim MonFichier As String
Dim NumLigne As Integer
Dim Reponse As Integer
 
On Error GoTo ErrorHandler2
NumLigne = Me.ListBox1.ListIndex
MonFichier = Me.ListBox1.Column(5, NumLigne)
MonFichier = "C:\Mes_PDFs\" & MonFichier & ".PDF"
 
If FichierExiste(MonFichier) = True Then
Reponse = MsgBox("Le fichier existe déjà. Voulez-vous le remplacer ? ", _
vbQuestion + vbYesNo + vbDefaultButton1, "CONFIRMATION DE REMPLACEMENT")
    If Reponse = vbYes Then
        Application.FileDialog(msoFileDialogOpen).Show
        Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
        PDFLocation = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        FileCopy PDFLocation, "C:\Mes_PDFs\" & MonFichier & ".PDF"
        MsgBox "Modification reussie", , "REUSSIE"
 
    ElseIf Reponse = vbNo Then
        Exit Sub
    End If
 
Else:
    If Len(Me.ListBox1.Column(5, NumLigne)) = 0 Then
    MsgBox "Aucun enregistrement pour ce nom", , "AUCUN ENREGISTREMENT"
 
    Else:
    Application.FileDialog(msoFileDialogOpen).Show
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    PDFLocation = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    FileCopy PDFLocation, MonFichier & ".PDF"
    End If
 
End If
 
ErrorHandler2:
    Exit Sub
 
End Sub

Au niveau du bouton « Afficher le fichier PDF »

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'-------- AFFICHER LES FICHIERS PDF -----------------------------------
 
Private Sub Afficher_Pdf_Click()
Dim File As String
Dim NumLigne As Integer
 
On Error GoTo ErrorHandler
NumLigne = Me.ListBox1.ListIndex
File = Me.ListBox1.Column(5, NumLigne)
File = "C:\Mes_PDFs\" & Me.ListBox1.Column(5, NumLigne) & ".PDF"
ThisWorkbook.FollowHyperlink File & ".PDF"
 
ErrorHandler:
Exit Sub
End Sub

23/03/2023, 09h07
marionmlt

1 pièce(s) jointe(s)

lien PDF

Bonjour Niagala,

Je vous remercie vraiment pour tout ça,
j'ai retravailler le code pour qu'il colle à mon fichier et j'ai un soucis sur le "ajouter PDF" et "afficher PDF".

Ajouter le PDF fonctionne parfaitement bien, par contre si je change de mot clé et que la source PDF change, ça m'affiche le PDF que je viens d'ajouter et si j'ajoute le nouveau PDF correspondant, ça me le remplace, et ainsi de suite. en fait je crois que le fichier excel ne peut gérer qu'un fichier à la fois.

Ce que j'ai fait pour le coup, c'est qu'en colonne F, j'ai mis les liens hypertexte des PDF correspondants.
est-ce que c'est envisageable en solution bis de mettre un code pour que le bouton "afficher PDF" fasses une sorte de "recherchev et clique" du lien sur la cellule de la colonne F correspondante ?

Je vous joint mon fichier à jour si vous souhaitez.
Pièce jointe 636207

merci à vous !
23/03/2023, 15h18
Niagala

1 pièce(s) jointe(s)

Bonjour marionmlt
Tu as fait quelques erreurs qui se sont payées très chères sinon il n'y a pas de problème dans le code.

Première erreur : Ajout PDF

Code:

MonFichier = "S:\VDO" & MonFichier & ".PDF"

Omission de l'antislash juste après le nom du dossier

Bon code

Code:

MonFichier = "S:\VDO\" & MonFichier & ".PDF"

Cette erreur est répétée deux fois dans cette partie Ajout PDF.

Deuxième erreur : Afficher PDF

Code:

File= "S:\VDO" & MonFichier & ".PDF"

Ici en plus de l'omission de l'antislash c'est « File » et non « MonFichier»

Bon code

Code:

File= "S:\VDO\" & File & ".PDF"
23/03/2023, 15h54
Niagala

Bonjour marionmlt

Le nom des fichiers Pdf à importer doit être la même que celui inscrit dans la colonne F ( Lien ).
Si un enregistrement possède déjà un fichier Pdf, un message apparait et propose de remplacer ou non.
23/03/2023, 15h56
marionmlt

Citation:

Envoyé par Niagala

Bonjour marionmlt

Le nom des fichiers Pdf à importer doit être la même que celui inscrit dans la colonne F ( Lien ).
Si un enregistrement possède déjà un fichier Pdf, un message apparait et propose de remplacer ou non.

Bonjour Niagala,

oui c'est ce que je viens de comprendre ^^
Je suis en train de renommer toutes les cellules de la colonne,
je vous tiens au courant si ça fonctionne ! :)
23/03/2023, 16h16
Niagala

Les corrections au niveau du code ont été effectuées dans la version 4 du fichier.
N’oublie pas cette fois-ci les « Antislash » après le nom du dossier dans ton fichier source.
Tiens moi au courant je regarderai plus tard.
23/03/2023, 16h27
marionmlt

Merci

C'est merveilleux, ça fonctionne !

j'ai enlevé les ".PDF" et laissé juste "" pour les codes Monfichier et File, car ça me créait un document "abcdefg.PDF.PDF"
MonFichier = "S:\VDO\[...]\" & MonFichier & ""
FileCopy PDFLocation, "S:\VDO\[...]\" & MonFichier & ""
File = "S:\VDO\[...]\" & File & ""

Par contre j'ai laissé le ".PDF" à
ThisWorkbook.FollowHyperlink File & ".PDF"

et ça fonctionne parfaitement ! :)
un grand merci
23/03/2023, 16h31
Niagala

Citation:

et ça fonctionne parfaitement ! :)
un grand merci

Je suis très content de pouvoir vous aider

N'oubliez pas de mettre « Résolue »