Fonction rechercher sous vba avec Excel 2007

bonjour

Je me suis souvenu que j'avais déjà eu à programmer un cas similaire voici comment:
Faire une recherche dans la colonne Nom et memoriser l'emplacement ou se trouvent les noms recherchés.
On peut entrer seulement quelques caractères du début, pratique si on ne se souvient plus de l'orthographe exacte.

pour ça, ajoute à ta feuille une ListBox là ou il y a de la place ou juste en dessous du champ nom.
c'est sans importance car tu lui donne la propriété Visible=False, donc elle ne s'affichera pas à l'execution.

Si plus d'un nom est trouvé, la listbox est affichée, fait un double_clic sur le nom choisi, la listbox disparait.

Colle dans le code de ta feuille ce qui suit , et adapte le à ton cas.
'*****************************************************
'bouton Rechercher
Private Sub Rechercher_Click()
Dim l1 As Integer, l2 As Integer, ltxt0 As Integer
Dim i As Integer, txt0 As String, txt1 As String

'effacer la listbox
ListBox1.Clear

'lire le champ nom
'adapter TextBox1.Text d'aprés ta Form
'tu peut entrer un nom partiel
'Ex: pour "dup" on recupere "DUPONT" "DUPIUS" "DUPALAIS"..
txt0 = TextBox1.Text
'longueur de la chaine à comparer
ltxt0 = Len(txt0)
'si la chaine est vide on ne fait rien
If ltxt0 = 0 Then Exit Sub

'on commence la recherche
'l1 est le numéro de la ligne ou commence la recherche
'si l1 est connue remplacer par sa valeur
'l1=1 'par exemple
l1 = ActiveCell.Row

'on regarde ou se trouve la dernière ligne du taleau
'si l2 est connue remplacer par sa valeur
'l2=254 'par exemple
ActiveCell.SpecialCells(xlLastCell).Select
l2 = ActiveCell.Row

'revient en haut du tableau
Range("A1").Select

'de la première à la dernière ligne
'on suppose que les noms sont dans la colonne 1
'sinon ajuster Celles(i,..)
For i = l1 To l2
'placer le contenu de la cellule dans txt1
txt1 = Cells(i, 1).Text
'comparer en majuscules avec le nom cherché
If UCase(Left(txt1, ltxt0)) = UCase(txt0) Then
'si c'est bon on l'ajoute a la ListBox1
'je conserve en préfixe la valeur de la ligne ou il se trouve
ListBox1.AddItem (Str(i) & " : " & txt1)
End If
Next

'on regarde le contenu de ListBox1
Select Case ListBox1.ListCount
Case 0 ' vide
MsgBox "N'éxiste pas"

Case 1 ' un seul correspond
'lire l'enregistrement 0
txt1 = ListBox1.List(0)
'recuperer la n° de la ligne ou se trouve le nom dans le tableau
'c'est le préfixe que j'ai conservé plus haut
i = Val(txt1)
'lire les valeur de la ligne du taleau (Nom,Prenom...)
'pour tester j'ai juste affiché les valeurs
'remplace ces deux lignes par ton propre code
txt1 = Cells(i, 1).Text & "," & Cells(i, 2).Text
MsgBox txt1
'
'
Case Else 'sinom montre la listbox pour faire un choix
ListBox1.Visible = True
End Select
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim lig As Integer, ind As Integer
Dim txt As String
'indice du choix
ind = ListBox1.ListIndex
'texte choisi
txt = ListBox1.List(ind)
'recuperer la n° de la ligne ou se trouve le nom dans le tableau
'c'est le préfixe que j'ai conservé plus haut
lig = Val(txt)
'faire disparaire la listbox
ListBox1.Visible = False
'lire les valeur de la ligne du taleau (Nom,Prenom...)
'pour tester j'ai juste affiché les valeurs
'remplace ces deux lignes par ton propre code
txt = Cells(lig, 1).Text & "," & Cells(lig, 2).Text
MsgBox txt
End Sub
'*****************************************************

Voilà, j'espère que ça pourra te servir.
Salut Nikki74

Bonsoir et merci pour ta réponse. Je test demain et je te dit si ça à marcher ou non. Merci beaucoup

Bonsoir à tous. Alors voilà, j'ai essayé d'adapter mon code mais je n'ai pas réussi :s Je ne savais pas trop où insérer quoi ! Donc au final ça me marquait toujours "n'éxiste pas" ! Pas facile de débuter dans la vie :(

Bonjour,

Peux - tu me poster la macro qui rempli ta userform, c'est-à-dire qui rempli toutes les textbox sur ta userform?
Avec ça je devrai pouvoir adapter la macro Rechercher_Click().

A+

Voici tous le code de mon bouton valider :

Private Sub Quitter_Click()
Dim Q As Integer
Q = MsgBox("Voulez-vous quitter ?", vbYesNo + vbQuestion)
If Q = 7 Then Exit Sub
If Q = 6 Then
Unload Me
End If
End Sub

Private Sub UserForm_Initialize()

With Pays
.AddItem "SUISSE"
.AddItem "RUSSIE"
.AddItem "ITALIE"
.AddItem "IRLANDE"
.AddItem "HOLLANDE"
.AddItem "FRANCE"
.AddItem "DANEMARK"
.AddItem "BELGIQUE"
.AddItem "ALLEMAGNE"

End With

With Typedepeau
.AddItem "Normal"
.AddItem "Grasse"
.AddItem "Sèche"
.AddItem "Acnéique"
.AddItem "Sensible"
End With

With Fournisseuraccès
.AddItem "wanadoo.fr"
.AddItem "orange.fr"
.AddItem "hotmail.fr"
.AddItem "hotmail.com"
.AddItem "yahoo.fr"
.AddItem "bluewin.fr"
End With

End Sub

Private Sub Valider_Click()

Dim Z As Integer
Z = Sheets("Clientes").Range("A65536").End(xlUp).Row + 1
    If Me.Nom.Value = "" Then
        MsgBox "Il faut au moins mettre le nom !", vbCritical + vbOKOnly
    Exit Sub
    End If
        Sheets("Clientes").Range("A" & Z).Value = Nom.Value
        Sheets("Clientes").Range("B" & Z).Value = Prénom.Value
        Sheets("Clientes").Range("C" & Z).Value = Datedenaissance.Value
        Sheets("Clientes").Range("D" & Z).Value = Numérocliente.Value
        Sheets("Clientes").Range("E" & Z).Value = Adresse.Value
        Sheets("Clientes").Range("F" & Z).Value = Codepostal.Value
        Sheets("Clientes").Range("G" & Z).Value = Ville.Value
        Sheets("Clientes").Range("H" & Z).Value = Pays.Value
        Sheets("Clientes").Range("I" & Z).Value = Téléphone.Value
        Sheets("Clientes").Range("J" & Z).Value = Portable.Value
        Sheets("Clientes").Range("K" & Z).Value = Email.Value
        Sheets("Clientes").Range("L" & Z).Value = Fournisseuraccès.Value
        Sheets("Clientes").Range("M" & Z).Value = Typedepeau.Value
        Sheets("Clientes").Range("N" & Z).Value = Taille.Value
        Sheets("Clientes").Range("O" & Z).Value = Poids.Value
        Sheets("Clientes").Range("P" & Z).Value = Commentaires.Value
        MsgBox "Fiche rajoutée !", vbInformation + vbOKOnly
    Call Efface_Tout
End Sub

Sub Efface_Tout()
Dim ctl As Control
    For Each ctl In NouvelleCliente.Controls
    If TypeName(ctl) = "TextBox" Then ctl.Value = ""
    If TypeName(ctl) = "ComboBox" Then ctl.Value = ""
    Next ctl
End Sub

Et sinon, pendant que j'ai un sujet ouvert, autant poser ma question ici ^^

Quand je vais rajouter mes produits à vendre, il y a des textbox qui doivent recevoir le prix unitaire et la tva. Y'a t'il un moyen pour que le montant ttc apparaisse automatiquement. En fait, faire une compil de vba et de formules excel.

Merci pour la réponse.

Bonsoir, Nikky 74

Je crois que j'ai réussi à adapter la macro Rechercher() à ton cas.

Comment ça marche:
- Saisir un Nom dans le champ Nom (meme un nom partiel)
-lancer la recerche
-si aucun nom -> Message
-si 1 nom -> affichage immediat
-Si plus d'un nom -> Afficher listBox double clic sur choix
-si aucun ne convient double clic sur Fermer liste

'--------------------------------------------------------------------------
'bouton Rechercher
Private Sub Rechercher_Click()
Dim l1 As Integer, l2 As Integer, ltxt0 As Integer
Dim i As Integer, txt0 As String, txt1 As String

'effacer la listbox
ListBox1.Clear

'lire le champ nom
'adapter TextBox1.Text d'aprés ta Form
'tu peut entrer un nom partiel
'Ex: pour "dup" on recupere "DUPONT" "DUPIUS" "DUPALAIS"..
txt0 = Nom.Text

'longueur de la chaine à comparer
ltxt0 = Len(txt0)
'si la chaine est vide on ne fait rien
If ltxt0 = 0 Then Exit Sub

'on commence la recherche
Sheets("Clientes").Select
'l1 est le numéro de la ligne ou commence la recherche
l1 = 2 'par exemple

'on regarde ou se trouve la dernière ligne du taleau
ActiveCell.SpecialCells(xlLastCell).Select
l2 = ActiveCell.Row

'revient en haut du tableau
Range("A2").Select

'de la première à la dernière ligne
For i = l1 To l2
'placer le contenu de la cellule dans txt1
txt1 = Sheets("Clientes").Cells(i, 1).Text
'comparer en majuscules avec le nom cherché
If UCase(Left(txt1, ltxt0)) = UCase(txt0) Then
'si c'est bon on l'ajoute a la ListBox1
'je conserve en préfixe la valeur de la ligne ou il se trouve
txt1= txt1 & " " & Sheets("Clientes").Cells(i,2).Text ' on accole le prénom
ListBox1.AddItem (Str(i) & " : " & txt1)
End If
Next

'on regarde le contenu de ListBox1
Select Case ListBox1.ListCount
Case 0 ' vide
MsgBox "N'éxiste pas"

Case 1 ' un seul correspond
'lire l'enregistrement 0
txt1 = ListBox1.List(0)
'recuperer la n° de la ligne ou se trouve le nom dans le tableau
'c'est le préfixe que j'ai conservé plus haut
i = Val(txt1)
'lire les valeur de la ligne du taleau (Nom,Prenom...)
Nom.Value = Sheets("Clientes").Range("A" & i).Value
Prénom.Value = Sheets("Clientes").Range("B" & i).Value
Datedenaissance.Value = Sheets("Clientes").Range("C" & i).Value
Numérocliente.Value = Sheets("Clientes").Range("D" & i).Value
Adresse.Value = Sheets("Clientes").Range("E" & i).Value
Codepostal.Value = Sheets("Clientes").Range("F" & i).Value
Ville.Value = Sheets("Clientes").Range("G" & i).Value
Pays.Value = Sheets("Clientes").Range("H" & i).Value
Téléphone.Value = Sheets("Clientes").Range("I" & i).Value
Portable.Value = Sheets("Clientes").Range("J" & i).Value
Email.Value = Sheets("Clientes").Range("K" & i).Value
Fournisseuraccès.Value = Sheets("Clientes").Range("L" & i).Value
Typedepeau.Value = Sheets("Clientes").Range("M" & i).Value
Taille.Value = Sheets("Clientes").Range("N" & i).Value
Poids.Value = Sheets("Clientes").Range("O" & i).Value
Commentaires.ValueCase = Sheets("Clientes").Range("P" & i).Value

Case Else 'sinom montre la listbox pour faire un choix
ListBox1.AddItem (" 0 : Fermer la liste")
ListBox1.Visible = True

End Select

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Integer, ind As Integer
Dim txt As String
'indice du choix
ind = ListBox1.ListIndex
'texte choisi
txt = ListBox1.List(ind)
'recuperer la n° de la ligne ou se trouve le nom dans le tableau
'c'est le préfixe que j'ai conservé plus haut
i = Val(txt)
'faire disparaire la listbox
ListBox1.Visible = False
'lire les valeur de la ligne du taleau (Nom,Prenom...)
Nom.Value = Sheets("Clientes").Range("A" & i).Value
Prénom.Value = Sheets("Clientes").Range("B" & i).Value
Datedenaissance.Value = Sheets("Clientes").Range("C" & i).Value
Numérocliente.Value = Sheets("Clientes").Range("D" & i).Value
Adresse.Value = Sheets("Clientes").Range("E" & i).Value
Codepostal.Value = Sheets("Clientes").Range("F" & i).Value
Ville.Value = Sheets("Clientes").Range("G" & i).Value
Pays.Value = Sheets("Clientes").Range("H" & i).Value
Téléphone.Value = Sheets("Clientes").Range("I" & i).Value
Portable.Value = Sheets("Clientes").Range("J" & i).Value
Email.Value = Sheets("Clientes").Range("K" & i).Value
Fournisseuraccès.Value = Sheets("Clientes").Range("L" & i).Value
Typedepeau.Value = Sheets("Clientes").Range("M" & i).Value
Taille.Value = Sheets("Clientes").Range("N" & i).Value
Poids.Value = Sheets("Clientes").Range("O" & i).Value
Commentaires.ValueCase = Sheets("Clientes").Range("P" & i).Value
End Sub

J'ai testé chez moi et ça fonctionne

Pour ta deuxième question, on peut invoquer l'évènement Enter pour faire une action quand on tape sur Entrer.
Bonne soirée.

Ca marche ! Merci, merci infiniment ! Tu sais pas l'épine du pied que tu m'enlève, un grand soulagement ! Y'a juste un tout petit détail, quand je regarde la liste dans la liste box, à la fin des choix, il y a 0=effacer la liste. Quand je double clic dessus, ça me met une erreur. Quelle ligne de code je doit enlever pour supprimer ce choix ? Il ne me servira pas trop ! Si on peut pas, c'est pas grave ! Merci encore !

Et pour ma deuxième question, en fait, c'est un peu complexe. Je pense que c'est faisable mais je sais pas trop par ou commencer ! Je te fais quelque imprim écran pour te montrer ce que j'aimerais !

http://img517.imageshack.us/img517/2792/ficheproduitbq9.png

Donc voici ce que j'aimerais faire :

En noir ~> C'est nous qui entrons le montant correspondant

En rouge ~> Je l'insererai dans la racine de ma textbox seulement, il ne faut pas qu'il puisse être modifié ! Je préfererai l'insérer en textbox plutôt qu'en label pour la présentation ! La fille pas chiante !

En bleu ~> C'est ce qui est censé être calculé automatiquement ! Dans le prix d'achat ttc, c'est prix de vente par la tva ! Prix de vente ht, c'est prix d'achat ht multiplié par le coeff et ensuite le prix de vente ht par la tva pour nous donner le prix de vente ttc.

Est ce que tu voit un peu ce que je veux faire ? Parce que je ne voudrais pas insérer à chaque fois les formules dans ma feuille excel car après je risque de ne plus m'y retrouver entre formule et vba !

Voilà à peu près ! Merci encore pour ta réponse, merci pour tout.

Nikky

Bonsoir,

Au départ je pensais pouvoir cacher la listbox en appuyant sur la touche Esc mais ça me faisait aussi une erreur à l'execution . Alors j'ai pensé à cette astuce, avec Excel2003 je n'ai pas de problème.

La ligne à modifier se trouve dans la macro Rechercher_Click()

Case Else 'sinom montre la listbox pour faire un choix
'------>ListBox1.AddItem (" 0 : Fermer la liste")
ListBox1.Visible = True
Tu la met en commentaire comme e l'ai fait ci dessus ou bien tu la supprime.

Puis dans la macro ListBox1_DblClick() tu met en commentaire ou tu supprime la ligne

'---->If i = 0 Then Exit Sub 'cette ligne ne sert plus à rien.

Pour ce qui est de ta fiche Produits, les controles textbox qui ne doivent pas etre modifies doivent avoir la propiété Locked=True. Ainsi l'utilisateur ne peut pas en modifier le contenu.

Enfin pour calculerautomatiquemen les PrixAchatTTC, PrixVenteHT, PrixVenteTTC colle cette procedure dans le code du formulaire Fiche Produits

'--------------------------------------------------
Private Sub Nom_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim pa_ht As Double, pa_ttc As Double, coef As Double
Dim pv_ht As Double, pv_ttc As Double
Dim tva_A As Double, tva_V As Double

If KeyCode = 13 Then
'Changer PrixAchatHT par le nom du cotrole correspondant
pa_ht = Val(PrixAchatHT.Text)
'Changer Coeff par le nom du cotrole correspondant
coef = Val(Coeff.Text)
'Changer TVA_Achat par le nom du cotrole correspondant
tva_A = Val(TVA_Achat.Text) / 100
'Changer TVA_Vente par le nom du cotrole correspondant
tva_V = Val(TVA_TVA_Vente.Text) / 100
'Changer PrixAchatTTC par le nom du cotrole correspondant
pa_ttc = pa_ht + (pa_ht * tva_A)
PrixAchatTTC.Text = Str(pa_ttc) & " CHF"
'Changer PrixVenteHT par le nom du cotrole correspondant
pv_ht = pa_ht + (pa_ht * coef)
PrixVenteHT.Text = Str(pv_ht) & " CHF"
'Changer PrixVenteTTC par le nom du cotrole correspondant
pv_ttc = pv_ht + (pv_ht * tva_V)
PrixVenteTTC.Text = Str(pv_ttc) & " CHF"
End If

End Sub

Pour les nom des controles textbox j'ai inventé, à toi de les mettre en concordance.

Bonne soirée et à bientot.

PS: Il faut appuyer sur la touche Enter pour faire les calculs et mettre à jour les champs
Attention au point décimal, ça dépend des paramètres régionaux que tu peux régler dans le panneau de configuration de Windows. Faire des essais pour voir.

A+

Merci pour tout ! Je vais tester tout ça. Pour la listbox, c'est pas trop important pour le moment ! Je vais d'abord essayer pour mes prix d'achat et compagnie !

Merci vraiment pour l'aide que tu m'apporte !

Encore une chose, tant que j'y pense, le nom de la procedure n'est pas coorect.

Il faut lui donner le nom du controle PrixAchatHT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Courage.

Bonjour à tous. Je me permet de remonter ce sujet afin de ne pas en refaire un puisque mon problème concerne un peut tout ça... En fait, j'en reviens à mes fonctions rechercher.

Mon code marche très bien, sans soucis ! Seulement, afin de voir les produits que mes clientes on acheté, j'ai fait ma fiche avec trois onglets... Un pour les renseignements généraux, un pour les soins effectués et un pour les produits acheté. J'aimerais que quand je recherche une cliente, on puisse voir aussi les produits et soins achetés.

Et ensuite, toujours pour mes formules de calcul de tva, je n'ai pas réussi... Et comme je suis partie sur mes autres userforms, je ne suis plus revenu dessus depuis un moment. Mais je vais devoir m'y repencher.

Merci d'avance pour l'aide que vous pourrez m'apportez...

S'il vous plaît :(

Et pour mes formules de calcul, j'y arrive mais deux soucis. Le premier est qu'il me met un seul chiffre après la virgule alors que j'en veux deux. Et ensuite, il me ait un très grand arrondi. Par exemple pour un produit à 20 CHF il me met une tva de 1,4 CHF (je ne sais pas la suite du chiffre) au lieu de 1,52 CHF.

Merci à ceux qui pourront m'aider, c'est vraiment important pour moi et pour le travail de ma mère.

Merci...