Option Explicit 'pour la déclaration explicite des variables
'ce UserForm est appelé par la sub FORMULAIRE() (bouton "Formulaire")
Dim Ws As Worksheet 'variable pour un objet Worksheet, de niveau module,
'donc portée globale pour tous les Controls de ce UserForm
Const NbEnf As Byte = 3 'Nombre d'enfants maximum ; actuellement : 3 ;
'sera à ajuster si tu ajoutes d'autres colonnes pour plus d'enfants.
Const colDN As Byte = NbEnf + 5 'colonne de la Date de Naissance : 8 = H ;
'sera plus à droite si tu ajoutes d'autres colonnes pour plus d'enfants ;
'attention : tu ne devras PAS CHANGER 5 + NbEnf !
Const itbDE As Byte = NbEnf + 3 'index textbox dernier enfant ; ici : 6
Dim flag As Byte 'ATTENTION : NE PAS ENLEVER !!! (explications dans le code VBA)
Private Sub FillUF(lig&) 'sub appelée par cbx1_Change() et par GoParent()
Dim i As Byte: Application.ScreenUpdating = 0: tbxDN = Ws.Cells(lig, colDN)
For i = 0 To itbDE: Controls("tbx" & i) = Ws.Cells(lig, i + 1): Next i
End Sub
Private Sub cbx1_Change() 'liste déroulante
'si flag = 1, sortir, car c'est un appel implicite depuis la sub cmdModif_Click()
'MAIS AVANT de sortir, on met flag à 0, sans quoi choisir un nouvel item dans la
'liste déroulante ne mettra pas à jour toutes les TextBox !
If flag = 1 Then flag = 0: Exit Sub
'sinon, c'est que flag = 0, et donc on fait le traitement habituel qui suit :
'si la liste déroulante montre un item, mise à jour des TextBox
If cbx1.ListIndex > -1 Then FillUF cbx1.ListIndex + 2
End Sub
Private Sub tbx0_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub ClrUF(k As Byte) 'sub appelée par cmdClr_Click() et par cmdAdd_Click()
If k = 1 Then _
If MsgBox("Voulez-vous effacer les donnée du UserForm ?", _
4, "Confirmation") <> 6 Then Exit Sub
Dim i As Byte 'efface toutes les cases du UF (les tbx et cbx1)
For i = 0 To itbDE: Controls("tbx" & i) = "": Next i
tbxDN = "": cbx1.ListIndex = -1
End Sub
Private Sub cmdClr_Click() 'bouton effacer
ClrUF 1
End Sub
Private Sub cmdAdd_Click() 'bouton ajouter
If tbx0 = "" Then Exit Sub 'sortie de la sub si pas de nom prénom !
Dim cel As Range: Set cel = Ws.Columns(1).Find(tbx0, , -4163, 1, 1)
If Not cel Is Nothing Then MsgBox tbx0 & " existe déjà !": Exit Sub
If MsgBox("Êtes-vous certain de vouloir INSÉRER ce nouveau contact ?", _
4, "Demande de confirmation") <> 6 Then Exit Sub
Dim chn$, lg1&, lg2&, i As Byte, j As Byte: Application.ScreenUpdating = 0
lg1 = cbx1.ListCount: cbx1.AddItem 'ajout d'une ligne à la liste déroulante cbx1
cbx1.List(lg1, 0) = tbx0: cbx1.List(lg1, 1) = tbxDN 'nom prénom & date naissance
lg1 = Ws.Cells(Rows.Count, 1).End(3).Row + 1 'dernière ligne du tableau + 1
Ws.Cells(lg1, 1) = tbx0: Ws.Cells(lg1, colDN) = tbxDN: lg2 = lg1
For i = 1 To itbDE 'conjoint, parents, et enfants
chn = Controls("tbx" & i)
If chn <> "" Then
Set cel = Ws.Columns(1).Find(chn, , -4163, 1, 1)
If cel Is Nothing Then
cbx1.AddItem chn: Ws.Cells(lg1, i + 1) = chn
lg2 = lg2 + 1: Ws.Cells(lg2, 1) = chn
Select Case i
Case 1: Ws.Cells(lg2, 2) = tbx0
For j = 1 To NbEnf
Ws.Cells(lg2, 4 + j) = Controls("tbx" & 3 + j)
Next j
Case 2, 3: Ws.Cells(lg2, 5) = tbx0
Case Else
Ws.Cells(lg2, 3) = tbx0: Ws.Cells(lg2, 4) = tbx1
End Select
Else
MsgBox chn & " existe déjà !"
End If
End If
Next i
cbx1.ListIndex = -1 'pour que la liste déroulante ne montre pas d'item
Range(Cells(lg1, 1), Cells(lg2, colDN)).Borders.LineStyle = 1 'bordures
Application.ScreenUpdating = -1
MsgBox "La personne présente a bien été ajoutée." 'l'ajout est confirmé
ClrUF 2 'on efface toutes les cases du UF
End Sub
Private Sub cmdModif_Click() 'bouton modifier
Dim k&: k = cbx1.ListIndex: If k = -1 Then Exit Sub 'On sort si pas de sélection
If MsgBox("Êtes-vous certain de vouloir modifier les infos de cette personne ?", _
vbYesNo, "Demande de confirmation") <> vbYes Then Exit Sub
'mise à jour des cellules avec toutes les TextBox
Dim lig&, i%: lig = cbx1.ListIndex + 2: Ws.Cells(lig, colDN) = tbxDN
For i = 0 To itbDE: Ws.Cells(lig, i + 1) = Controls("tbx" & i): Next i
'SI on a CHANGÉ tbx0, ALORS mise à jour de l'item affiché de la liste déroulante.
'ATTENTION : si on change .List(k), il y a un appel implicite à cbx1_Change(),
'qu'on ne peut PAS éviter, même si on désactive les évènements de l'application !
'grâce à flag = 1, ça permettra de sortir AUSSITÔT de la sub cbx1_Change().
With cbx1
If .List(k) <> tbx0 Then flag = 1: .List(k) = tbx0
End With
End Sub
Private Sub GoParent(chn$)
Dim cel As Range: Set cel = Ws.Columns(1).Find(chn, , -4163, 1, 1)
If Not cel Is Nothing Then cbx1.ListIndex = -1: FillUF cel.Row
End Sub
Private Sub cmdGoPère_Click() 'bouton GoPère
Dim père$: père = tbx2: If père <> "" Then GoParent père
End Sub
Private Sub cmdGoMère_Click() 'bouton GoMère
Dim mère$: mère = tbx3: If mère <> "" Then GoParent mère
End Sub
Private Sub cmdQuit_Click() 'bouton quitter
Unload Me 'Unload => ferme le Userform et l'efface de la mémoire ; les valeurs de ses contrôles
'sont à alors perdues ; Me : Référence à l'objet en cours, c'est-à-dire le formulaire UserForm1
End Sub
'Cet évènement est important car au lancement du Userform, il permet de définir les propriétés des
'objets et les valeurs par défaut des variables ; cette sub est lancée par la sub FORMULAIRE().
Private Sub UserForm_Initialize() 'initialisation de UserForm1
Dim T, n&, i& 'ATTENTION : il ne faut PAS mettre de type pour T !
Set Ws = Worksheets("Feuil1") 'Ws fait référence à la feuille de calcul "Feuil1"
n = Ws.Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
n = n - 1: T = Ws.[A2].Resize(n, colDN)
For i = 1 To n: T(i, 2) = T(i, colDN): Next i
ReDim Preserve T(1 To n, 1 To 2)
cbx1.List = T: flag = 0
End Sub