Macro de recherche Résolu/Fermé

Question

Bonjour,
 voilà je débute en macro, j'ai une base de donnée de licenciés, j'ai fais un userform dans lequel je rentre les informations des licenciés (nom, prénom, date etc...) j'ai créé un bouton recherche sur mon userform je voudrai quand je rentre un nom et que je clic sur recherche que tous les champ du userform se remplisse par les informations correspondantes....

j'ai un 2éme soucis j'ai une macro qui me calcule l'age à partir de la date de naissance rentrée mais le format de sorti n'est pas bon voici ma macro:

        
'***********
' Calcul age    
'***********


Cells(a, 5).Select
Dim dnai
dnai = Cells(a, 4)
Dim age
Elt = Evaluate("DATEDIF(" & Now & ",dnai,""y""")
age = DateDiff(Now, dnai, "y") '------------------------------> pb de format ??
Cells(a, 5).Value = age

Merci d'avance pour vos réponses à un ou deux de mes problèmes

Polux31 · Answer

Bonjour,

Voilà un exemple de calcul de l'age. La date de naissance est dans la cellule A1 du premier onglet.

Sub CalculAge()
Dim mDate As Date
Dim age As Integer

    mDate = Sheets(1).Range("A1").Value
    age = DateDiff("yyyy", mDate, Date)
    
    MsgBox age & " ans"
    
End Sub

;o)

informatifien · Answer

impeccable merci de ta réponse ça marche tip top et pour mon premier problème tu connai la solution?

Polux31 · Answer

C'est un peu juste comme infos pour t'aider.

Il nous faudrait au moins ton code et que tu nous indiques clairement là où ça coince.

pijaku · Answer

Bonjour,
On continue ici?
1ère question : bouton recherche
j'ai fais un userform dans lequel je rentre les informations des licenciés nom, prénom, date etc...
Je suppose que ces informations peuvent être complétées par l'utilisateur en utilisant des TextBox.
nom = TextBox1, prénom TextBox2 date = TextBox3

Tout comme vous pouvez compléter une base de données à l'aide de textbox par le code :
[A1] = TextBox1
[B1] = TextBox2
[C1] = TextBox3
à l'inverse vous pouvez compléter vos textbox à l'aide de votre base de données
TextBox1 = ActiveCell (ou TextBox1 = [A1])
TextBox2 = ActiveCell.Offsel(0, 1)
TextBox3 = ActiveCell.Offsel(0, 2)

Polux31 · Answer

Bonjour pijaku,

Je pense que c'est la recherche dans sa base d'après un "nom" qui pose problème, l'affichage n'est que le résultat de la recheche ...

J'ai suggéré de mettre ici le code qui pose problème afin d'y apporter les éventuelles corrections, pour éviter le "clé en main" ... Attendons ... ^^

Merci d'être intervenu sur le second post que je n'ai vu qu'après avoir répondu à celui là.

informatifien · Answer

bon j'ai cloturé le doublon je m'excuse j'avais fais une fausse manipulation ce matin, oui exact polux me l'a montré j'ai dis telle que je l'ai finalisé ce n'etait pas du tout pour en recolter les lauriers donc je m'excuse, par contre quand vous dite qu'il faut donner ses sources qu'entendez vous par sources? Pour ce qui concerne mon problème j'ai donc une base de donnée voici le code du userform de création de fiche: Private Sub Creer_Click() '********************* ' fermeture formulaire '********************* formulaire.Hide '******************** ' Remplissage cellule '******************** Dim a a = 1 Do a = a + 1 Loop Until Application.Cells(a, 2) = Empty Cells(a, 1).Value = Nom Cells(a, 2).Value = Prenom Cells(a, 3).Value = Licence Cells(a, 4).Value = Naissance Cells(a, 7).Value = Adresse Cells(a, 8).Value = Mail Cells(a, 9).Value = Fixe Cells(a, 10).Value = Portable Cells(a, 13).Value = Paye Cells(a, 15).Value = Certif '*********** ' Calcul age '*********** Cells(a, 5).Select Dim dnai dnai = Cells(a, 4) Dim age As Integer age = DateDiff("yyyy", dnai, Date) Cells(a, 5).Value = age '****************** ' Calcul categories '****************** If Cells(a, 5) >= 8 And Cells(a, 5) <= 9 Then Cells(a, 6) = "Microbe" Cells(a, 12) = "41.90 €" Cells(a, 13) = "95 €" ElseIf Cells(a, 5) >= 10 And Cells(a, 5) <= 11 Then Cells(a, 6) = "Poussin" Cells(a, 12) = "41.90 €" Cells(a, 13) = "95 €" ElseIf Cells(a, 5) >= 12 And Cells(a, 5) <= 13 Then Cells(a, 6) = "benjamin" Cells(a, 12) = "41.90 €" Cells(a, 13) = "95 €" ElseIf Cells(a, 5) >= 14 And Cells(a, 5) <= 15 Then Cells(a, 6) = "Minime" Cells(a, 12) = "41.90 €" Cells(a, 13) = "95 €" ElseIf Cells(a, 5) >= 16 And Cells(a, 5) <= 17 Then Cells(a, 6) = "Cadet" Cells(a, 12) = "41.90 €" Cells(a, 13) = "95 €" ElseIf Cells(a, 5) >= 18 And Cells(a, 5) <= 19 Then Cells(a, 6) = "Junior" Cells(a, 12) = "52.60 €" Cells(a, 13) = "110 €" ElseIf Cells(a, 5) >= 20 And Cells(a, 5) <= 39 Then Cells(a, 6) = "Senior" Cells(a, 12) = "52.60 €" Cells(a, 13) = "110 €" ElseIf Cells(a, 5) >= 40 And Cells(a, 5) <= 80 Then Cells(a, 6) = "Vétéran" Cells(a, 12) = "52.60 €" Cells("L" & a) = "110 €" Else Cells(a, 6) = "" Cells(a, 12) = "" Cells(a, 13) = "" End If '****************** ' Affichage message '****************** MsgBox ("Fiche crée avec succés") End Sub celà marche à merveille, maintenant quand je lance mon userform apres avoir rentré des licensiés, je rempli par exemple le textbox = nom et que je clic sur le bouton "rechercher" là je voudrai que le 'Private Sub Rechercher_Click()' lui cherche les valeur des textbox vide et les remplisse avec les information correspondantes.... j'espere avoir été plus clair et je m'excuse encore pour mes erreus c'est la premiere foi que je demande de l'aide sur un forum :)

informatifien · Answer

ah et je vois que le clé en main n'est pas possible bon ben je vais essayer de pondre un debut de code mais je sais pas trop par uo commencer.....j'ai juste fais ca pour l'instant mais c'est loin d'etre suffisant je crois:

Private Sub Rechercher_Click()
Dim a
a = 1
Do
a = a + 1
Loop Until Application.Cells(a, 2) = Empty

        Range Cells(a, 1).Select
        Range Cells(a, 2).Select
        Range Cells(a, 3).Select
        Range Cells(a, 4).Select
        Range Cells(a, 5).Select
        Range Cells(a, 6).Select
        Range Cells(a, 7).Select
        Range Cells(a, 8).Select
        Range Cells(a, 9).Select
        Range Cells(a, 10).Select
        Range Cells(a, 11).Select
        Range Cells(a, 12).Select
        Range Cells(a, 13).Select
        Range Cells(a, 14).Select
        Range Cells(a, 15).Select
        Selection.Show


End Sub


voilà le début

informatifien · Answer

oula décidément j'ai du mal je viens de poster quelque chose et cela n'apparé pas je recommence:

 donc je précisai que quand j'écris  Cells(a, 1).Value = Nom, Nom c'est le (Name) de ma textbox que j'ai renommée pour m'y retrouver plus facilement.

Pour mieux m'expliquer je souhaite pouvoir remplir dans mon userform la textbox Nom par exemple et que la macro remplisse toutes les autres textbox (prenom,date. .. .) après avoir cliquer sur le bouton Rechercher, pour après au choix supprimer la fiche concernée ou la modifier . . .j'espère avoir été plus clair . . .

et pour mieux comprendre les macro et  débuter mon Private Sub Rechercher_Click(), voici une question dois je déclarer les valeurs des cellules vis à vis de leur textbox ou les avoir déclarées dans mon Private Sub Creer_Click() est-ce suffisant et valable pour tout le reste de la macro du userform?

merci à tous

informatifien · Answer

pardon pijaku je comprend pas ce qui se passe quand j'ai envoyé mes messages il n'y avait pas encore ta réponse qui répond à mes questions donc je dois redéclarer mes textbox ok par contre pour la recherche je ne connais pas la commande et ne la trouve pas dans l'aide.....

et autre question 'offset' signifit quoi?

merci d'avance

informatifien · Answer

bon je viens de tenter un truc à en m'aidant de ce topic:

https://forums.commentcamarche.net/forum/affich-2889413-excel-macro-ptite-macro-de-recherche-simple

ca donne ca:

Private Sub Rechercher_Click()

Dim b
b = 1
Do
b = b + 1
Loop Until Application.Cells(b, 2) = Empty

MyValue = Nom
Range("A1").Select
For b = 1 To 150
If ActiveCell.Value = MyValue Then
 
Prenom = Cells(b, 2).Value
Licence = Cells(b, 3).Value
Naissance = Cells(b, 4).Value
Adresse = Cells(b, 7).Value
Mail = Cells(b, 8).Value
Fixe = Cells(b, 9).Value
Portable = Cells(b, 10).Value
Paye = Cells(b, 13).Value
Certif = Cells(b, 15).Value
 
ElseIf ActiveCell.Value = "" Then
MsgBox ("Fiche inexistante")
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next

End Sub

après plusieurs modification je n'ai plus d'erreur lors de l'exécution mais la macro ne m'affiche pas les valeurs dans les case.....

merci

informatifien · Answer

rooooo mais c'est dingue je poste des messages avant de voir ta réponse alors que tu la poste avant moi c'est dingue je suis en train d'essayer la methode kobaya mais je suis pas sur de tout avoir pigé  . . .

informatifien · Answer

bon j'ai donc refais le code de kobaya comme ca:

Private Sub Rechercher_Click()

Dim rngTrouve As Range
Dim strChaine As String
    
    strChaine = Nom
    Set rngTrouve = ActiveSheet.Columns(1).Cells.Find(what:=strChaine)
    
    If rngTrouve Is Nothing Then
        MsgBox "Pas trouvé"
    Else
        rngTrouve.Select
Prenom = activecells.Offset(b, 2)
Licence = activecells.Offset(b, 3)
Naissance = activecells.Offset(b, 4)
Adresse = activecells.Offset(b, 5)
Mail = activecells.Offset(b, 8)
Fixe = activecells.Offset(b, 9)
Portable = activecells.Offset(b, 10)
Paye = activecells.Offset(b, 13)
Certif = activecells.Offset(b, 15)

    End If
    
    Set rngTrouve = Nothing
End Sub

là j'ai à la ligne prénom:

 erreur d'execution '424'
objet requis

???? désolé j'ai du mal mais j'apprend le VBA un peu tout seul. . . .enfin plus maintenat ;)

informatifien · Answer

j'avai fait une erreur de syntaxe pas de 'S' à activecell.offset donc là c'est mieux il trouve bien le nom que je recherche mais n'affiche toujours pas le reste je pense que c'est dut à ma variable 'b' mais je sais pas quelle erreur j'ai fait .. . .

informatifien · Answer

oui ok j'ai bien compri mais la variable m'evitai de réflechir à quel colone correspond à quoi. . ..

informatifien · Answer

bon j'ai changé du tout au tout voici le code final et il marche:

Private Sub Rechercher_Click()
Dim a As Integer
a = 1
While Range("A" & a) <> Nom
a = a + 1
If a = 150 Then
MsgBox "Fiche inexistante, vérifiez le nom saisi"
Exit Sub
End If

Wend

Prenom = Range("B" & a).Value
Licence = Range("C" & a).Value
Naissance = Range("D" & a).Value
Adresse = Range("G" & a).Value
Mail = Range("H" & a).Value
Fixe = Range("I" & a).Value
Portable = Range("J" & a).Value
Paye = Range("M" & a).Value
   
End Sub

Ma source???  un collègue de travail qui m'a suggéré d'utiliser une condition, ce qui finalement simplifie la chose....non?
--L'informatique est à la société ce que la femme est au monde. . . c'est compliqué mais on ne peut s'en passer ;)

informatifien · Answer

oui j'en aurai surement d'autres en tout cas merci déjà pour le coup de main ;)

Macro de recherche

16 réponses

Discussions similaires