Enregistrer, afficher et modifier des données dans un formulaire

ARNAUD ZIRIPE

XLDnaute Occasionnel
Bonjour à tous. Je souhaiterais créer un formulaire capable de saisir ,modifier,afficher des données et des photos pour ma sœur qui est directrice d'une école maternelle. Vous trouverez plus de détails dans le fichier joint.
J'ai beau essayé je n'y arrive pas. J'ai tenté d'utiliser ces différents codes trouvés sur le site de M. Boisgontier Jacques en les adaptant mais je n'y arrive pas.
Voici les codes:

Consultation/Modification/Création

Dim f, ligneEnreg

Private Sub UserForm_Initialize()

Set f = Sheets("bd")

Clé = f.Range("B2:B" & f.[B65000].End(xlUp).Row)

Me.Service.List = Array("Etudes", "Informatique", "Marketing", "Production")

Me.Loisirs.List = Array("Lecture", "Cinéma", "Vélo", "Natation", "Internet")

'-------------avec tri---------------

Call Tri(Clé, LBound(Clé), UBound(Clé))

Me.ChoixNom.List = Clé

Me.ChoixNom.ListIndex = 0

End Sub


Private Sub ChoixNom_Click()

ligneEnreg = Sheets("BD").[B:B].Find(ChoixNom, LookIn:=xlValues).Row

Me.nom = f.Cells(ligneEnreg, 2)

Me.Marié = f.Cells(ligneEnreg, 3)

Me.Date_naissance = f.Cells(ligneEnreg, 4)

Me.Service = f.Cells(ligneEnreg, 5)

Me.Ville = f.Cells(ligneEnreg, 6)

Me.Salaire = f.Cells(ligneEnreg, 7)

'-- civilité

For Each c In Me.Civilité.Controls

If f.Cells(ligneEnreg, "a") = c.Caption Then c.Value = True

Next c

'--- loisirs

temp = f.Cells(ligneEnreg, 8)

a = Split(temp, ";")

For j = 0 To Me.Loisirs.ListCount - 1: Me.Loisirs.Selected(j) = False: Next j

If UBound(a) >= 0 Then

For j = 0 To Me.Loisirs.ListCount - 1

If Not IsError(Application.Match(Me.Loisirs.List(j), a, 0)) Then

Me.Loisirs.Selected(j) = True

Else

Me.Loisirs.Selected(j) = False

End If

Next j

End If

End Sub


Private Sub B_validation_Click()

If Me.nom = "" Then

MsgBox "Saisir un nom"

Me.nom.SetFocus

Exit Sub

End If

If Not IsDate(Me.Date_naissance) Then

MsgBox "Saisir une date"

Me.Date_naissance.SetFocus

Exit Sub

End If

If Not IsNumeric(Me.Salaire) Then

MsgBox "Saisir un salaire"

Me.Salaire.SetFocus

Exit Sub

End If

'--- Transfert Formulaire dans BD

f.Cells(ligneEnreg, 2) = Application.Proper(Me!nom)

f.Cells(ligneEnreg, 3) = Me.Marié 'OuiNon(Me.Marié)

f.Cells(ligneEnreg, 4) = CVDate(Me.Date_naissance)

f.Cells(ligneEnreg, 5) = Me.Service

f.Cells(ligneEnreg, 6) = Me.Ville

f.Cells(ligneEnreg, 7) = CDbl(Me.Salaire)

'-- Civilité

temp = ""

For Each c In Me.Civilité.Controls

If c.Value = True Then

temp = c.Caption

End If

Next c

f.Cells(ligneEnreg, 1) = temp

'-- loisirs

temp = ""

For i = 0 To Me.Loisirs.ListCount - 1

If Me.Loisirs.Selected(i) = True Then temp = temp & Me.Loisirs.List(i) & ";"

Next i

f.Cells(ligneEnreg, 8) = temp

End Sub


Private Sub B_ajout_Click()

ligneEnreg = f.[A65000].End(xlUp).Row + 1

Me.nom = ""

Me.Marié = False

Me.Date_naissance = ""

Me.Service = ""

Me.Ville = ""

Me.Salaire = ""

For j = 0 To Me.Loisirs.ListCount - 1: Me.Loisirs.Selected(j) = False: Next j

Me.nom.SetFocus

End Sub


Private Sub b_fin_Click()

Unload Me

End Sub


Sub Tri(a, gauc, droi) ' Quick sort

ref = a((gauc + droi) \ 2, 1)

g = gauc: d = droi

Do

Do While a(g, 1) < ref: g = g + 1: Loop

Do While ref < a(d, 1): d = d - 1: Loop

If g <= d Then

temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp

g = g + 1: d = d - 1

End If

Loop While g <= d

If g < droi Then Call Tri(a, g, droi)

If gauc < d Then Call Tri(a, gauc, d)

End Sub

j'ai ajouté le fichier excel qui est "FOrmModifCreation"

et il y a aussi ce code qui concerne la consultation avec photo

Consultation avec photos


Les photos .jpg sont dans le même répertoire que ce fichier


Dim ligne

Dim maBD

Private Sub UserForm_Initialize()

Set maBD = Sheets("BD")

maBD.[A2:H2000].Sort key1:=maBD.[B2] ' Tri la BD

Me.ChoixNom.List = Range(maBD.[B2], maBD.[B65000].End(xlUp)).Value

Me.ChoixNom.ListIndex = 0

End Sub


Private Sub ChoixNom_Change()

ligne = [B2].Offset(ChoixNom.ListIndex, 0).Row

Me.nom = maBD.Cells(ligne, 2)

Me.Marié = maBD.Cells(ligne, 3)

Me.date_naissance = maBD.Cells(ligne, 4)

Me.service = maBD.Cells(ligne, 5)

Me.ville = maBD.Cells(ligne, 6)

Me.Salaire = maBD.Cells(ligne, 7)

'-- civilité

For Each c In Me.Civilité.Controls

If maBD.Cells(ligne, "a") = c.Caption Then c.Value = True

Next c
Répertoire = ThisWorkbook.Path

If Dir(Répertoire & "\" & Me.nom & ".jpg") <> "" Then

Me.Image1.Picture = LoadPicture(Répertoire & "\" & Me.nom & ".jpg")

Else

Me.Image1.Picture = LoadPicture

End If

End Sub


Private Sub B_suivant_Click()

If Me.ChoixNom.ListIndex < Me.ChoixNom.ListCount - 1 Then

Me.ChoixNom.ListIndex = Me.ChoixNom.ListIndex + 1

End If

End Sub


Private Sub b_précédent_Click()

If Me.ChoixNom.ListIndex > 0 Then

Me.ChoixNom.ListIndex = Me.ChoixNom.ListIndex - 1

End If

End Sub


Private Sub b_fin_Click()

Unload Me

End Sub

Voila je n'arrive pas à faire la combinaison de ses deux.
Je vous prie de bien vouloir m'aider. j'ajoute également le fichier de M. boisgontier Jacques
Merci de bien vouloir m'aider.
 

Pièces jointes

  • Inscription_consultation_modification.xlsm
    99.9 KB · Affichages: 42
  • FOrmModifCreation.xls
    107.5 KB · Affichages: 35
  • FormSuivantPrecedent.xls
    74.5 KB · Affichages: 38

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof