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
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 ?) :
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 :
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
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.
Henri