Fonction rechercher sous vba avec Excel 2007 Fermé

Question

Bonjour à vous.

Je débute en VBA et je suis en train de faire une application sur Excel pour faire de la gestion des stocks et un fichiers clientèle.

Je commence par programmer l'insertion, modification, suppression de mes fiches clientes mais aussi de la recherche par nom.

Donc dans mon code, j'ai réussi à faire s'afficher les informations que je voulais en tapant un nom seulement j'ai deux soucis :

- Si j'ai deux fois ou plus le même nom, il ne me recherche que le premier et comme je sais déjà par avance que certaines personnes ont le même nom, il faut pouvoir avoir une liste de choix. Voici mon code pour valider la recherche :

Private Sub Rechercher_Click()

Dim plge As Range
Set plge = Sheets("Clientes").Range("A2:A" & Range("A65536").End(xlUp).Row).Find(Nom.Value)
    If Not plge Is Nothing Then
    Prénom = plge.Offset(0, 1).Value
    Datedenaissance = plge.Offset(0, 2).Value
    Numérocliente = plge.Offset(0, 3).Value
    Adresse = plge.Offset(0, 4).Value
    Codepostal = plge.Offset(0, 5).Value
    Ville = plge.Offset(0, 6).Value
    Pays = plge.Offset(0, 7).Value
    Téléphone = plge.Offset(0, 8).Value
    Portable = plge.Offset(0, 9).Value
    Email = plge.Offset(0, 10).Value
    Fournisseuraccès = plge.Offset(0, 11).Value
    Typedepeau = plge.Offset(0, 12).Value
    Taille = plge.Offset(0, 13).Value
    Poids = plge.Offset(0, 14).Value
    Commentaires = plge.Offset(0, 15).Value
    Else
    MsgBox "N'éxiste pas"
    Call Efface_Tout
    End If

End Sub

Et mon deuxième soucis, je voudrais que, toujours à la recherche de mes noms, que si je tape un numéro de cliente, les infos s'affiche aussi. Donc j'ai essayer de réinsérer le même code en modifiant mes champs mais il m'a fait un bug ! Donc si vous savez comment je peux présenter ça,je suis preuneuse.

Voici un imprim écran de mon userform qui devra effectuer les recherches :

http://img170.imageshack.us/img170/9126/sanstitre1qy9.jpg

Merci d'avance pour votre aide ^^

amigo · Answer

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

Nikky 74 · Answer

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

Nikky 74 · Answer

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 :(

amigo · Answer

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+

Nikky 74 · Answer

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.

amigo · Answer

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.

Nikky 74 · Answer

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

amigo · Answer

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.

amigo · Answer

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+

Nikky 74 · Answer

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 !

amigo · Answer

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.

Nikky 74 · Answer

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...

Nikky 74 · Answer

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...