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.
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.
