Macro de recherche

Résolu
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

--
L'informatique est à la société ce que la femme est au monde. . . c'est compliqué mais on ne peut s'en passer ;)
Configuration: asus P5V800 / P4 2,8 Ghz / 1,5 Go Windows XP FireFox / IE 7

16 réponses

  • Votes
  • Date
  • Date décroissante
  1. 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)
    1. impeccable merci de ta réponse ça marche tip top et pour mon premier problème tu connai la solution?
      1. 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.
        1. Modérateur
          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)
          1. 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à.
            1. Modérateur
              Salut,
              Je pense que c'est la recherche dans sa base d'après un "nom" qui pose problème Exact mais tout comme toi, je ne voulais pas tout donner de suite...
              Attendons...
          2. 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 :)
            1. Modérateur
              Décomposons ce que tu veux faire :
              celà marche à merveilleje n'en doutais pas...
              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...
              1ère étape rechercher le TextBox"nom" dans la base de données
              2ème étape : renvoyer les cellules voisines dans les autres textbox. Ca tu sais faire, je te l'ai indiqué plus haut (textbox"prenom" = ActiveCell.Offset(0, 1))
              Ne te reste plus qu'à chercher la valeur du textboxnom dans la colonne noms.
          3. 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
            1. 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
              1. 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
                1. Modérateur
                  Salut,
                  En cherchant un peu avec google, tu aurais pu trouver la fonction Cells.Find qui nous intéresse et surtout ce vieux post de Kobaya.
                  Ta réponse est à la réponse 1 de ce sujet.

                  Tu n'as plus qu'à remplacer : MsgBox rngTrouve.Address par ce que tu veux faire une fois la valeur trouvée, c'est à dire :
                  - sélectionner la cellule,
                  - retourner dans le formulaire la valeur de la cellule voisine (ou se trouve le prénom)
                  [c'est là qu'entre en jeu le "offset". ActiveCell désigne la cellule active, activeCell.Offset(ligne, colonne) désigne une cellule distante de autant de lignes et autant de colonnes. Exemple : ActiveCell.Offset(3, -2) désigne la cellule 3 lignes en dessous et 2 colonnes à gauche de la cellule active.]
                  Tout compris???
              2. 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
                1. 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é . . .
                  1. 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 ;)
                    1. 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 .. . .
                      1. Modérateur
                        mgtrouve.Select te sélectionne la cellule contenant la valeur recherchée.
                        Ensuite, tu n'as pas besoin de variable, les données sont fixes dans ta bdd? Col A : Noms, Col B : prénoms, Col C : date....
                        Donc ça nous donne :
                        mgtrouve.Select
                        TextBoxprenom = ActiveCell.Offset(0, 1) 'même ligne mais 1 colonne à droite
                        TextBoxdate = ActiveCell.Offset(0, 2) 'même ligne mais 2 colonnes à droite
                        etc...
                    2. oui ok j'ai bien compri mais la variable m'evitai de réflechir à quel colone correspond à quoi. . ..
                      1. Modérateur
                        dans ton exemple b est la ligne pas la colonne. Tu n'as donc plus à réfléchir car tes colonnes sont bien spécifiées 2, 3 etc??? remplace b par 0.
                        Reviens coller ton code final ici que l'on puisse le corriger.
                    3. 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 ;)
                      1. Modérateur
                        Ma source??? un collègue de travail. Tu aurais du citer son nom!! (je plaisante)
                        Beau travail. Je place ce sujet comme étant "résolu" et n'hésite pas à poser de nouvelles questions s'il y a lieu.
                        @ bientôt
                    4. oui j'en aurai surement d'autres en tout cas merci déjà pour le coup de main ;)