Créer un formulaire

Bonjour à tous,

Je voudrais créer une base de donnée concernant les mot employés en cuisine.

Je voudrai pouvoir rentrer un nouveau mot et sa définition à partir d'un formulaire et pouvoir chercher la définition à partir de ce même formulaire.

Pourriez-vous m'aider à le réaliser sur la base du fichier joint?

Merci beaucoup

Pioupiou57640

13lexique.xlsx (59.42 Ko)

bonsoir PiouPiou57640

Un essai avec le fichier joint.

Cdt

Henri

16pioupiou.xlsm (71.79 Ko)

Bonsoir AFEH,

Oui c'est le genre de chose que je recherche mis à part le fait que j'i essayé de faire un nouvelle enregistrement. Cela fonctionne bien mais il est impossible de le retrouver dans ma liste par la suite

Cordialement,

Pioupiou

Bonjour,

Voici un point de départ pour la recherche et l'ajout (je n'ai pas encore fait la partie suppression car je ne sais pas si elle est utile ?) :

13lexique.xlsm (73.29 Ko)

Bonjour Theze,

Merci pour votre travail, si je peux me permettre dans la listebox 1 je n'aurai (enfin si j'avais su le faire) Repris le mot recherché,et n'est-il pas possible de renvoyer à la ligne car le texte est trop long dans certains cas.

Effectivement la fonction supprimer pourrais être utile (Voir pour ma propre formation)

Merci beaucoup

Pioupiou

dans la listebox 1 je n'aurai (enfin si j'avais su le faire) Repris le mot recherché

Comment veux tu savoir si les lettres entrées dans le TextBox sont exactement le texte cherché ? La procédure "TextBox1_Change()" permet de remplir la IistBox avec les mots commençants par les lettres saisies, quand la lister s'amenuise, il suffit alors de cliquer sur le mot recherché pour remplir le commentaire. Si tu ne veux pas que le mot apparaisse dans la ListBox, tu n'auras pas non plus le commentaire ou alors, tu ne sauras pas avec certitude que le commentaire affiché soit bien celui correspondant au mot !

n'est-il pas possible de renvoyer à la ligne car le texte est trop long dans certains cas.

Dans la ListBox c'est non et c'est pour cette raison qu'il y a le TextBox2 paramétré en multi-lignes

Voici le classeur avec la suppression :

18lexique-v2.xlsm (77.91 Ko)

Bonsoir Theze,

Je vous remercie pour tous ces conseils et j'en prends bonne note, Je vous remercie pour votre travail, car c'est ce dont jamais besoin.

Merci, je vais pouvoir mettre résolu à ma demande.

Jean-Marie

Bonjour Jean-Marie,

Content de t'avoir aidé

Re,

J'ai remarqué un petit soucis de fluidité suite à une suppression donc, j'ai modifier le code et je le poste entièrement ici si toi aussi tu as remarqué ça, il suffit de supprimer entièrement celui du module du formulaire (sauf Option Explicit) et de le remplacer par celui-ci :

Option Compare Text
Dim Tbl() As String

Private Sub UserForm_Initialize()

    Dim Plage As Range
    Dim I As Long

    'défini la plage à partir de A2
    Set Plage = DefPlage(Worksheets("Lexique"), 2)

    For I = 1 To Plage.Rows.Count

        ReDim Preserve Tbl(1 To 2, 1 To I)
        Tbl(1, I) = Plage(I, 1)
        Tbl(2, I) = Plage(I, 2)

    Next I

    'paramètre la ListBox
    ListBox1.ColumnCount = 3
    ListBox1.ColumnWidths = "100pt;290pt;0pt"

End Sub

Private Sub UserForm_Activate()

    TextBox1.SetFocus

End Sub

Private Sub ListBox1_Click()

    'inscrit le commentaire dans la zone de texte
    TextBox2.Text = ListBox1.Column(1, ListBox1.ListIndex)

End Sub

Private Sub TextBox1_Change()

    Dim I As Long
    Dim J As Long

    If TextBox1.Text = "" Then Exit Sub

    'popule la ListBox en fonction des lettres entrée
    With ListBox1

        .Clear

        For I = 1 To UBound(Tbl, 2)

            If Tbl(1, I) Like TextBox1.Text & "*" Then

                'évite les lettre d'index
                If Len(Tbl(1, I)) > 1 Then

                    J = J + 1
                    .AddItem Tbl(1, I)
                    .Column(1, J - 1) = Tbl(2, I)
                    .Column(2, J - 1) = I

                End If

            End If

        Next I

    End With

End Sub

Private Sub CommandButton1_Click()

    Dim Plage As Range
    Dim Cel As Range
    Dim I As Long

    'si la ListBox n'est pas vide, le mot existe donc fin
    If ListBox1.ListCount <> 0 Then Exit Sub

    'demande si on souhaite l'ajouter, si Non, fin
    If MsgBox("Le nom '" & TextBox1.Text & "' ne se trouve pas dans le lexique, voulez-vous l'ajouter ?", 36) = vbNo Then Exit Sub

    'demande si on veux ou non un commentaire
    If TextBox2.Text = "" Then

        If MsgBox("Sans commentaire ?", 36) = vbNo Then Exit Sub

    End If

    With Worksheets("Lexique")

        'recherche de la première cellule vide en colonne A
        Set Cel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)

        'inscription des valeurs
        Cel.Value = TextBox1.Text
        Cel.Offset(, 1).Value = TextBox2.Text

        'redéfini la plage seulement sur la colonne A et recherche si l'index existe...
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set Cel = Plage.Find(Left(TextBox1.Text, 1), , xlValues, xlWhole)

        'si il n'existe pas, l'ajoute et le formate puis tri la plage
        'la repasse au tableau et execute la Sub "TextBox1_Change()" pour remplir la ListBox
        If Cel Is Nothing Then

            Set Cel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
            Cel.Value = Left(TextBox1.Text, 1)
            Cel.Font.Bold = True
            Cel.Font.Size = 18
            Cel.Font.Color = 683492

            Set Plage = DefPlage(Worksheets("Lexique"), 2)

            Plage.Sort Plage(1, 1), xlAscending

            Erase Tbl()

            For I = 1 To Plage.Rows.Count

                ReDim Preserve Tbl(1 To 2, 1 To I)
                Tbl(1, I) = Plage(1, I)
                Tbl(2, I) = Plage(2, I)

            Next I

            TextBox1_Change

        End If

    End With

End Sub

Private Sub CommandButton3_Click()

    Dim Plage As Range
    Dim Cel As Range

    If ListBox1.ListIndex = -1 Then Exit Sub

    If MsgBox("Voulez-vous vraiment supprimer le mot '" & ListBox1.List(ListBox1.ListIndex) & "' ?" _
              & vbCrLf _
              & vbCrLf _
              & "Attention, le mot sera définitivement supprimé du fichier !", 36) = vbNo Then Exit Sub

    'défini la plage sur la colonne A à partir de A2
    With Worksheets("Lexique"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    'effectue la recherche et supprime la ligne
    Set Cel = Plage.Find(ListBox1.List(ListBox1.ListIndex), , xlValues, xlWhole)

    Cel.EntireRow.Delete

    SuppDansTableau ListBox1.Column(2, ListBox1.ListIndex)

    DoEvents

    TextBox2.Text = ""

    TextBox1_Change

End Sub

Private Sub CommandButton2_Click()

    Unload Me

End Sub

Sub SuppDansTableau(Ligne As Long)

    Dim I As Long

    For I = Ligne To UBound(Tbl, 2) - 1

        Tbl(1, I) = Tbl(1, I + 1)
        Tbl(2, I) = Tbl(2, I + 1)

    Next I

    ReDim Preserve Tbl(1 To 2, 1 To UBound(Tbl, 2) - 1)

End Sub

Private Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Bonjour PiouPiou et Theze

Comme j'avais démarré la discussion et que j'étais parti sur les notions AJOUTER et MODIFIER, j'ai ajouté un nouveau bouton "Modifier Commentaire" permettant de modifier les données déjà enregistrées dans la version proposée par Theze.

Merci à lui.

D'autre part, je m'aperçois que lors de l'ajout d'un nouveau mot avec l'initiale qui existe dans la liste, l'enregistrement se fait en dernière ligne libre. J'ai ajouté un code "Indexer" pour trier par ordre alphabétique toute la base à la fermeture du formulaire.

Cdt

Henri

21lexique-v3.xlsm (41.27 Ko)

Merci à vous deux,

Le choix de l'un ou l'autre étant difficile, je prends donc les deux et vous en remercie beaucoup.

Je vous souhaite une bonne journée

Merci beaucoup.

Pioupiou

Bonsoir PiouPiou et le forum,

Voici une version que j'avais commencée mais pas finalisée.

Aujourd'hui, je pense qu'elle fonctionne correctement.

La feuille "Lexique" est transformée en Tableau1.

Le formulaire contient

  • un TextBox pour AJOUT
  • un ComboBox pour saisir l'Initiale
  • un 2ème Combobox pour la liste des noms selon l'initiale choisie, qui va alimenter le 2ème TextBox avec la définition.
  • 4 boutons: Ajouter, Modifier, Supprimer et Quitter.
Cdt

Henri

Rechercher des sujets similaires à "creer formulaire"