Répertoire client Excel – Hutchinson Roubaix

Publié le

Répertoire Excel avec moteur de recherche

Présentation du projet

Ce projet découle d’une nouvelle demande de mon responsable. Il m’a demandé de réaliser un répertoire avec un moteur de recherche intégré qui lui permettrait de retrouver facilement les clients, fournisseurs, sous-traitants et organismes de sécurité. J’ai donc tout de suite pensé à réaliser un petit programme sur Excel en VBA

Réalisation du projet

Dans un premier temps il faut réaliser le tableau de base du répertoire avec le nom, le mail, téléphone, etc.

Codage

Nous allons maintenant associer au bouton recherche une macro qui servira de moteur de recherche. Nous allons donc commencer par faire une boite de dialogue

Private Sub CommandButton1_Click()

reponse = InputBox(« Mot à rechercher »)

‘Ici on crée la boite de dialogue
If reponse = «  » Then
MsgBox (« Vous devez saisir au moins un mot !!! »)
Exit Sub
End If

‘Dans le cas ou rien n’est rentré on affiche un message et on quitte la boite de dialogue

Sheets(« Résultat recherche »).Select

‘On sélectionne la feuille où l’on veut afficher les résultats

Range(« A9:A » & Range(« A65536 »).End(xlUp).Row).ClearContents

Range(« B9:B » & Range(« B65536 »).End(xlUp).Row).ClearContents

‘On nettoie la zone où d’anciennes recherches pourraient se trouver

Call recherche(reponse)

‘On appelle le module qui recherchera le résultat (ici réponse)
End Sub

Création du module de recherche

Nous voulons que la recherche se fasse dans tout les onglets du fichier. On commence donc par  :

Sub recherche(mot)

For Each ws In Sheets

‘Pour chaque onglet dans le fichier

ligne=9

If ws.Name <> « Résultat recherche » Then

‘Si le nom est différent de la page où on affiche le résultat alors on continue le programme

With ws.Cells

Set cherche = .Find(mot, LookIn:=xlValues, lookat:=xlPart)

‘On définis la recherche
If Not cherche Is Nothing Then
firstAddress = cherche.Address
Do
Sheets(« Résultat recherche »).Cells(ligne, 1).Select

‘On sélectionne l’emplacement ou il va mettre les recherches

Selection.Hyperlinks.Add Anchor:=Selection, Address:= » », SubAddress:= _
ws.Name & « ! » & cherche.Address, TextToDisplay:=cherche.Value

Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

‘On crée un lien hypertexte pour chaque correspondance et on le suit   

Columns(ActiveCell.Column).Select
Range(« A1 ») = ActiveCell.Column

  ‘On active la colonne contenant la cellule où la correspondance se trouve, et on affecte sa valeur à A1

If Range(« A1 ») = 8 Then
Sheets(« Résultat recherche »).Select
Cells(ligne, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = « Thème »
ActiveCell.Offset(0, -1).Select
End If

If Range(« A1 ») = 5 Then
Sheets(« Résultat recherche »).Select
Cells(ligne, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = « Nom »
ActiveCell.Offset(0, -1).Select
End If

If Range(« A1 ») = 6 Then
Sheets(« Résultat recherche »).Select
Cells(ligne, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = « Mail »
ActiveCell.Offset(0, -1).Select
End If

If Range(« A1 ») = 7 Then
Sheets(« Résultat recherche »).Select
Cells(ligne, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = « Téléphone »
ActiveCell.Offset(0, -1).Select
End If

If Range(« A1 ») = 9 Then
Sheets(« Résultat recherche »).Select
Cells(ligne, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = « Mot clés »
ActiveCell.Offset(0, -1).Select
End If

‘Tout ces blocs IF servent à écrire le type de correspondance 
ligne = ligne + 1
Set cherche = .FindNext(cherche)
Loop While Not cherche Is Nothing And cherche.Address <>firstAddress
trouve = True
End If
End With
End If
Next ws
If Not trouve Then MsgBox (« Pas de  » & mot &  » trouvé dans ce fichier »)

‘On traite le cas où rien n’est trouvé

End Sub

>>>Programme finis<<<

Merci de m’avoir lu, si jamais vous avez des questions n’hésitez pas à me mail où à commenter 🙂

Laisser un commentaire