Private Sub cmdValid_Click()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=PWD, UserInterfaceOnly:=True
Next ws
If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche)
MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub
End If
If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub
tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD"))
tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD"))
Dim NP&, GR As Byte, SL As Byte, dlg&
With Worksheets("Feuil1")...
bonjour;Bonjour soan;
merci beaucoup c'est super, je l'ai testé et s'marche très bien.
bonne continuation dans ce que tu fait.
a très bientôt
Option Explicit
Const PWD$ = "nono79" '<--- mot de passe à changer (seulement à cet endroit)
Private Sub tbx03_Change() 'Date Début
Dim lng As Byte: lng = Len(tbx03): If lng = 3 Or lng = 6 Then tbx03 = tbx03 & "/"
End Sub
Private Sub tbx04_Change() 'Date Fin
Dim lng As Byte: lng = Len(tbx04): If lng = 3 Or lng = 6 Then tbx04 = tbx03 & "/"
End Sub
Private Sub tbx06_Change() 'Date Nais
Dim lng As Byte: lng = Len(tbx06): If lng = 3 Or lng = 6 Then tbx06 = tbx03 & "/"
End Sub
Private Sub tbx10_Change() 'Date L
Dim lng As Byte: lng = Len(tbx10): If lng = 3 Or lng = 6 Then tbx10 = tbx03 & "/"
End Sub
Private Sub tbx02_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'N° Groupe
Dim Session$, Groupe%, T, k&, n&, i&
Session = cbx01: Groupe = Val(tbx02): If Groupe = 0 Then Exit Sub
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 2).End(3).Row: If n = 1 Then Exit Sub
T = .[B1].Resize(n, 2)
For i = 2 To n
If Session = T(i, 2) And Groupe = T(i, 1) Then k = k + 1
Next i
MsgBox "Session : " & Session & vbLf & vbLf & "Groupe " & Format(Groupe, "00") & " :" _
& vbLf & vbLf & Space$(8) & k & " personnes", 64, "Nombre de personnes"
If k = 15 Then
MsgBox "Vous ne pouvez pas dépasser 15 personnes par groupe." & vbLf & vbLf _
& "Veuillez créer un nouveau groupe.", 48, "15 personnes maximum"
tbx02 = "": cbx01 = "": Cancel = -1
End If
End With
End Sub
Private Sub cmdNew_Click()
Dim i As Byte
For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i
For i = 1 To 10: Controls("cbx" & Format(i, "00")) = "": Next i
End Sub
Private Sub cmdModif_Click()
If cbx09 = "" Then
MsgBox "Veuillez sélectionner le Nom/Prénom de la personne à modifier": Exit Sub
End If
With Worksheets("Feuil1")
.Unprotect PWD
With .Cells(cbx09.ListIndex + 2, 1)
.Value = tbx01 'N° Personnel
.Offset(, 1) = tbx02 'N° Groupe
.Offset(, 2) = cbx01 'N° Sess
.Offset(, 3) = tbx05 'Nom et Prénom
.Offset(, 4) = cbx05 'Nom et Prénom (arabe)
.Offset(, 5) = tbx06 'Date Nais
.Offset(, 6) = tbx07 'Lieu A / Lieu 2
.Offset(, 7) = cbx06 'Ville
.Offset(, 8) = tbx08 'Adresse
.Offset(, 9) = tbx09 'Entreprise A / Entreprise
.Offset(, 10) = cbx08 'Permis
.Offset(, 11) = tbx10 'Date L
.Offset(, 12) = tbx11 'Lieu B / Lieu 3
.Offset(, 13) = cbx07 'Spécialité
.Offset(, 14) = tbx03 'Date Début
.Offset(, 15) = tbx04 'Date Fin
.Offset(, 16) = cbx02 'Entreprise B / Lieu 1
.Offset(, 17) = cbx04 'Prise en charge
.Offset(, 18) = cbx03 'N° Salle
End With
.Protect PWD: .Select
End With
End Sub
Private Sub cmdValid_Click()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=PWD, UserInterfaceOnly:=True
Next ws
If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche)
MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub
End If
If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub
tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD"))
tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD"))
With Worksheets("Feuil1").Cells(Rows.Count, 1).End(3).Row + 1
.Value = tbx01 'N° Personnel
.Offset(, 1) = tbx02 'N° Groupe
.Offset(, 2) = cbx01 'N° Sess
.Offset(, 3) = tbx05 'Nom et Prénom
.Offset(, 4) = cbx05 'Nom et Prénom (arabe)
.Offset(, 5) = tbx06 'Date Nais
.Offset(, 6) = tbx07 'Lieu A / Lieu 2
.Offset(, 7) = cbx06 'Ville
.Offset(, 8) = tbx08 'Adresse
.Offset(, 9) = tbx09 'Entreprise A / Entreprise
.Offset(, 10) = cbx08 'Permis
.Offset(, 11) = tbx10 'Date L
.Offset(, 12) = tbx11 'Lieu B / Lieu 3
.Offset(, 13) = cbx07 'Spécialité
.Offset(, 14) = tbx03 'Date Début
.Offset(, 15) = tbx04 'Date Fin
.Offset(, 16) = cbx02 'Entreprise B / Lieu 1
.Offset(, 17) = cbx04 'Prise en charge
.Offset(, 18) = cbx03 'N° Salle
.Parent.Select
End With
Unload UserForm1: UserForm1.Show
End Sub
Private Sub ShowPers(T, i&)
tbx01 = T(i, 1) 'N° Personnel
tbx02 = T(i, 2) 'N° Groupe
cbx01 = T(i, 3) 'N° Sess
tbx05 = T(i, 4) 'Nom et Prénom
cbx05 = T(i, 5) 'Nom et Prénom (arabe)
tbx06 = T(i, 6) 'Date Nais
tbx07 = T(i, 7) 'Lieu A / Lieu 2
cbx06 = T(i, 8) 'Ville
tbx08 = T(i, 9) 'Adresse
tbx09 = T(i, 10) 'Entreprise A / Entreprise
cbx08 = T(i, 11) 'Permis
tbx10 = T(i, 12) 'Date L
tbx11 = T(i, 13) 'Lieu B / Lieu 3
cbx07 = T(i, 14) 'Spécialité
tbx03 = T(i, 15) 'Date Début
tbx04 = T(i, 16) 'Date Fin
cbx02 = T(i, 17) 'Entreprise B / Lieu 1
cbx04 = T(i, 18) 'Prise en charge
cbx03 = T(i, 19) 'N° Salle
Worksheets("Feuil1").Select
End Sub
Private Sub cmdSearch_Click()
Dim np$, sp$: np = cbx09: sp = cbx10
If np = "" Then MsgBox "Veuillez indiquer la personne recherchée" _
& vbLf & vbLf & "(nom & prénom séparés par un espace)": Exit Sub
If sp = "" Then MsgBox "Veuillez indiquer la spécialité": Exit Sub
Dim T, chn$, p%, n&, i&
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
T = .[A1].Resize(n, 19)
End With
For i = 2 To n
If T(i, 4) = np Then
chn = T(i, 14)
If chn <> "" Then
p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1
If RTrim$(Left$(chn, p)) = sp Then ShowPers T, i: Exit Sub
End If
End If
Next i
For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i
For i = 1 To 8: Controls("cbx" & Format(i, "00")) = "": Next i
End Sub
Private Sub UserForm_Initialize()
'N° Personnel
tbx01 = Format(Application.WorksheetFunction.Max(Worksheets("Feuil1").Columns(1)) + 1, "0000")
'liste cbx09 : Personnes (Nom et Prénom), sans doublons
Dim T, d, n&, i&
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 4).End(3).Row: If n = 1 Then Exit Sub
T = .[D1].Resize(n)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To n
If T(i, 1) <> "" Then d(T(i, 1)) = ""
Next i
cbx09.List = d.Keys
'liste cbx10 : Spécialité
Dim chn$, p%, lig As Byte: lig = 1
With Worksheets("Feuil4")
Do
chn = .Cells(lig, 7): If chn = "" Then Exit Sub
p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1
cbx10.AddItem RTrim$(Left$(chn, p)): lig = lig + 1
Loop
End With
End Sub
Private Sub cmdExit_Click()
Application.ScreenUpdating = 0: Worksheets("Feuil3").Select: Unload Me
End Sub
Bonjour soan;Bonjour nono79, le fil,
ton fichier en retour.j'ai fait plein d'modifs dans UserForm1 et le code VBA de ce UF, alors je te souhaite bon courage pour tout vérifier très soigneusement !
VB:Option Explicit Const PWD$ = "nono79" '<--- mot de passe à changer (seulement à cet endroit) Private Sub tbx03_Change() 'Date Début Dim lng As Byte: lng = Len(tbx03): If lng = 3 Or lng = 6 Then tbx03 = tbx03 & "/" End Sub Private Sub tbx04_Change() 'Date Fin Dim lng As Byte: lng = Len(tbx04): If lng = 3 Or lng = 6 Then tbx04 = tbx03 & "/" End Sub Private Sub tbx06_Change() 'Date Nais Dim lng As Byte: lng = Len(tbx06): If lng = 3 Or lng = 6 Then tbx06 = tbx03 & "/" End Sub Private Sub tbx10_Change() 'Date L Dim lng As Byte: lng = Len(tbx10): If lng = 3 Or lng = 6 Then tbx10 = tbx03 & "/" End Sub Private Sub tbx02_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'N° Groupe Dim Session$, Groupe%, T, k&, n&, i& Session = cbx01: Groupe = Val(tbx02): If Groupe = 0 Then Exit Sub With Worksheets("Feuil1") n = .Cells(Rows.Count, 2).End(3).Row: If n = 1 Then Exit Sub T = .[B1].Resize(n, 2) For i = 2 To n If Session = T(i, 2) And Groupe = T(i, 1) Then k = k + 1 Next i MsgBox "Session : " & Session & vbLf & vbLf & "Groupe " & Format(Groupe, "00") & " :" _ & vbLf & vbLf & Space$(8) & k & " personnes", 64, "Nombre de personnes" If k = 15 Then MsgBox "Vous ne pouvez pas dépasser 15 personnes par groupe." & vbLf & vbLf _ & "Veuillez créer un nouveau groupe.", 48, "15 personnes maximum" tbx02 = "": cbx01 = "": Cancel = -1 End If End With End Sub Private Sub cmdNew_Click() Dim i As Byte For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i For i = 1 To 10: Controls("cbx" & Format(i, "00")) = "": Next i End Sub Private Sub cmdModif_Click() If cbx09 = "" Then MsgBox "Veuillez sélectionner le Nom/Prénom de la personne à modifier": Exit Sub End If With Worksheets("Feuil1") .Unprotect PWD With .Cells(cbx09.ListIndex + 2, 1) .Value = tbx01 'N° Personnel .Offset(, 1) = tbx02 'N° Groupe .Offset(, 2) = cbx01 'N° Sess .Offset(, 3) = tbx05 'Nom et Prénom .Offset(, 4) = cbx05 'Nom et Prénom (arabe) .Offset(, 5) = tbx06 'Date Nais .Offset(, 6) = tbx07 'Lieu A / Lieu 2 .Offset(, 7) = cbx06 'Ville .Offset(, 8) = tbx08 'Adresse .Offset(, 9) = tbx09 'Entreprise A / Entreprise .Offset(, 10) = cbx08 'Permis .Offset(, 11) = tbx10 'Date L .Offset(, 12) = tbx11 'Lieu B / Lieu 3 .Offset(, 13) = cbx07 'Spécialité .Offset(, 14) = tbx03 'Date Début .Offset(, 15) = tbx04 'Date Fin .Offset(, 16) = cbx02 'Entreprise B / Lieu 1 .Offset(, 17) = cbx04 'Prise en charge .Offset(, 18) = cbx03 'N° Salle End With .Protect PWD: .Select End With End Sub Private Sub cmdValid_Click() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets ws.Protect Password:=PWD, UserInterfaceOnly:=True Next ws If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche) MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub End If If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD")) tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD")) With Worksheets("Feuil1").Cells(Rows.Count, 1).End(3).Row + 1 .Value = tbx01 'N° Personnel .Offset(, 1) = tbx02 'N° Groupe .Offset(, 2) = cbx01 'N° Sess .Offset(, 3) = tbx05 'Nom et Prénom .Offset(, 4) = cbx05 'Nom et Prénom (arabe) .Offset(, 5) = tbx06 'Date Nais .Offset(, 6) = tbx07 'Lieu A / Lieu 2 .Offset(, 7) = cbx06 'Ville .Offset(, 8) = tbx08 'Adresse .Offset(, 9) = tbx09 'Entreprise A / Entreprise .Offset(, 10) = cbx08 'Permis .Offset(, 11) = tbx10 'Date L .Offset(, 12) = tbx11 'Lieu B / Lieu 3 .Offset(, 13) = cbx07 'Spécialité .Offset(, 14) = tbx03 'Date Début .Offset(, 15) = tbx04 'Date Fin .Offset(, 16) = cbx02 'Entreprise B / Lieu 1 .Offset(, 17) = cbx04 'Prise en charge .Offset(, 18) = cbx03 'N° Salle .Parent.Select End With Unload UserForm1: UserForm1.Show End Sub Private Sub ShowPers(T, i&) tbx01 = T(i, 1) 'N° Personnel tbx02 = T(i, 2) 'N° Groupe cbx01 = T(i, 3) 'N° Sess tbx05 = T(i, 4) 'Nom et Prénom cbx05 = T(i, 5) 'Nom et Prénom (arabe) tbx06 = T(i, 6) 'Date Nais tbx07 = T(i, 7) 'Lieu A / Lieu 2 cbx06 = T(i, 8) 'Ville tbx08 = T(i, 9) 'Adresse tbx09 = T(i, 10) 'Entreprise A / Entreprise cbx08 = T(i, 11) 'Permis tbx10 = T(i, 12) 'Date L tbx11 = T(i, 13) 'Lieu B / Lieu 3 cbx07 = T(i, 14) 'Spécialité tbx03 = T(i, 15) 'Date Début tbx04 = T(i, 16) 'Date Fin cbx02 = T(i, 17) 'Entreprise B / Lieu 1 cbx04 = T(i, 18) 'Prise en charge cbx03 = T(i, 19) 'N° Salle Worksheets("Feuil1").Select End Sub Private Sub cmdSearch_Click() Dim np$, sp$: np = cbx09: sp = cbx10 If np = "" Then MsgBox "Veuillez indiquer la personne recherchée" _ & vbLf & vbLf & "(nom & prénom séparés par un espace)": Exit Sub If sp = "" Then MsgBox "Veuillez indiquer la spécialité": Exit Sub Dim T, chn$, p%, n&, i& With Worksheets("Feuil1") n = .Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub T = .[A1].Resize(n, 19) End With For i = 2 To n If T(i, 4) = np Then chn = T(i, 14) If chn <> "" Then p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1 If RTrim$(Left$(chn, p)) = sp Then ShowPers T, i: Exit Sub End If End If Next i For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i For i = 1 To 8: Controls("cbx" & Format(i, "00")) = "": Next i End Sub Private Sub UserForm_Initialize() 'N° Personnel tbx01 = Format(Application.WorksheetFunction.Max(Worksheets("Feuil1").Columns(1)) + 1, "0000") 'liste cbx09 : Personnes (Nom et Prénom), sans doublons Dim T, d, n&, i& With Worksheets("Feuil1") n = .Cells(Rows.Count, 4).End(3).Row: If n = 1 Then Exit Sub T = .[D1].Resize(n) End With Set d = CreateObject("Scripting.Dictionary") For i = 2 To n If T(i, 1) <> "" Then d(T(i, 1)) = "" Next i cbx09.List = d.Keys 'liste cbx10 : Spécialité Dim chn$, p%, lig As Byte: lig = 1 With Worksheets("Feuil4") Do chn = .Cells(lig, 7): If chn = "" Then Exit Sub p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1 cbx10.AddItem RTrim$(Left$(chn, p)): lig = lig + 1 Loop End With End Sub Private Sub cmdExit_Click() Application.ScreenUpdating = 0: Worksheets("Feuil3").Select: Unload Me End Sub
soan
bonjour soan;Bonjour nono79,
merci pour ton retour !j'espère que tu pourras arriver à faire toi-même l'adaptation pour d'autres UserForm ! sinon, je pourrai t'aider, bien sûr : on est sur un forum d'entraide. (et si je suis disponible)
soan
Option Explicit
Const PWD$ = "nono79" '<--- mot de passe à changer (seulement à cet endroit)
Dim LR& 'Ligne de la personne qui a été trouvée par la Recherche ; 0 = non trouvée
Private Sub tbx03_Change() 'Date Début
Dim lng As Byte: lng = Len(tbx03): If lng = 3 Or lng = 6 Then tbx03 = tbx03 & "/"
End Sub
Private Sub tbx04_Change() 'Date Fin
Dim lng As Byte: lng = Len(tbx04): If lng = 3 Or lng = 6 Then tbx04 = tbx03 & "/"
End Sub
Private Sub tbx06_Change() 'Date Nais
Dim lng As Byte: lng = Len(tbx06): If lng = 3 Or lng = 6 Then tbx06 = tbx03 & "/"
End Sub
Private Sub tbx10_Change() 'Date L
Dim lng As Byte: lng = Len(tbx10): If lng = 3 Or lng = 6 Then tbx10 = tbx03 & "/"
End Sub
Private Sub tbx02_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'N° Groupe
Dim Session$, Groupe%, T, k&, n&, i&
Session = cbx01: Groupe = Val(tbx02): If Groupe = 0 Then Exit Sub
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 2).End(3).Row: If n = 1 Then Exit Sub
T = .[B1].Resize(n, 2)
For i = 2 To n
If Session = T(i, 2) And Groupe = T(i, 1) Then k = k + 1
Next i
MsgBox "Session : " & Session & vbLf & vbLf & "Groupe " & Format(Groupe, "00") & " :" _
& vbLf & vbLf & Space$(8) & k & " personnes", 64, "Nombre de personnes"
If k = 15 Then
MsgBox "Vous ne pouvez pas dépasser 15 personnes par groupe." & vbLf & vbLf _
& "Veuillez créer un nouveau groupe.", 48, "15 personnes maximum"
tbx02 = "": cbx01 = "": Cancel = -1
End If
End With
End Sub
Private Sub cmdNew_Click()
Dim i As Byte
For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i
For i = 1 To 10: Controls("cbx" & Format(i, "00")) = "": Next i
End Sub
Private Sub cmdModif_Click()
If cbx09 = "" Then MsgBox "Veuillez sélectionner le nom/prénom de la personne à modifier.": Exit Sub
If cbx10 = "" Then MsgBox "Veuillez sélectionner la spécialité de la personne à modifier.": Exit Sub
If tbx05 = "" Then MsgBox "Merci de cliquer sur le bouton Recherche.": Exit Sub
If LR = 0 Then Exit Sub
Dim NP&, GR As Byte, SL As Byte: NP = Val(tbx01): GR = Val(tbx02): SL = Val(cbx03)
With Worksheets("Feuil1")
.Unprotect PWD
With .Cells(LR, 1)
.Value = Format(NP, "0000") 'N° Personnel
.Offset(, 1) = Format(GR, "00") 'N° Groupe
.Offset(, 2) = cbx01 'N° Sess
.Offset(, 3) = tbx05 'Nom et Prénom
.Offset(, 4) = cbx05 'Nom et Prénom (arabe)
.Offset(, 5) = CDate(tbx06) 'Date Nais
.Offset(, 6) = tbx07 'Lieu A / Lieu 2
.Offset(, 7) = cbx06 'Ville
.Offset(, 8) = tbx08 'Adresse
.Offset(, 9) = tbx09 'Entreprise A / Entreprise
.Offset(, 10) = cbx08 'Permis
.Offset(, 11) = CDate(tbx10) 'Date L
.Offset(, 12) = tbx11 'Lieu B / Lieu 3
.Offset(, 13) = cbx07 'Spécialité
.Offset(, 14) = CDate(tbx03) 'Date Début
.Offset(, 15) = CDate(tbx04) 'Date Fin
.Offset(, 16) = cbx02 'Entreprise B / Lieu 1
.Offset(, 17) = cbx04 'Prise en charge
.Offset(, 18) = Format(SL, "00") 'N° Salle
End With
.Protect PWD: .Select
End With
End Sub
Private Sub cmdValid_Click()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=PWD, UserInterfaceOnly:=True
Next ws
If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche)
MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub
End If
If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub
tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD"))
tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD"))
Dim NP&, GR As Byte, SL As Byte, dlg&: dlg = Cells(Rows.Count, 1).End(3).Row
GR = Val(tbx02): SL = Val(cbx03): NP = Val(tbx01): If NP > dlg Then NP = dlg
With Worksheets("Feuil1").Cells(dlg + 1, 1)
.Value = Format(NP, "0000") 'N° Personnel
.Offset(, 1) = Format(GR, "00") 'N° Groupe
.Offset(, 2) = cbx01 'N° Sess
.Offset(, 3) = tbx05 'Nom et Prénom
.Offset(, 4) = cbx05 'Nom et Prénom (arabe)
.Offset(, 5) = CDate(tbx06) 'Date Nais
.Offset(, 6) = tbx07 'Lieu A / Lieu 2
.Offset(, 7) = cbx06 'Ville
.Offset(, 8) = tbx08 'Adresse
.Offset(, 9) = tbx09 'Entreprise A / Entreprise
.Offset(, 10) = cbx08 'Permis
.Offset(, 11) = CDate(tbx10) 'Date L
.Offset(, 12) = tbx11 'Lieu B / Lieu 3
.Offset(, 13) = cbx07 'Spécialité
.Offset(, 14) = CDate(tbx03) 'Date Début
.Offset(, 15) = CDate(tbx04) 'Date Fin
.Offset(, 16) = cbx02 'Entreprise B / Lieu 1
.Offset(, 17) = cbx04 'Prise en charge
.Offset(, 18) = Format(SL, "00") 'N° Salle
.Parent.Select
End With
Unload UserForm1: UserForm1.Show
End Sub
Private Sub ShowPers(T)
tbx01 = Format(T(LR, 1), "0000") 'N° Personnel
tbx02 = T(LR, 2) 'N° Groupe
cbx01 = T(LR, 3) 'N° Sess
tbx05 = T(LR, 4) 'Nom et Prénom
cbx05 = T(LR, 5) 'Nom et Prénom (arabe)
tbx06 = T(LR, 6) 'Date Nais
tbx07 = T(LR, 7) 'Lieu A / Lieu 2
cbx06 = T(LR, 8) 'Ville
tbx08 = T(LR, 9) 'Adresse
tbx09 = T(LR, 10) 'Entreprise A / Entreprise
cbx08 = T(LR, 11) 'Permis
tbx10 = T(LR, 12) 'Date L
tbx11 = T(LR, 13) 'Lieu B / Lieu 3
cbx07 = T(LR, 14) 'Spécialité
tbx03 = T(LR, 15) 'Date Début
tbx04 = T(LR, 16) 'Date Fin
cbx02 = T(LR, 17) 'Entreprise B / Lieu 1
cbx04 = T(LR, 18) 'Prise en charge
cbx03 = T(LR, 19) 'N° Salle
Worksheets("Feuil1").Select
End Sub
Private Sub cmdSearch_Click()
Dim NP$, sp$: NP = cbx09: sp = cbx10
If NP = "" Then MsgBox "Veuillez indiquer la personne recherchée." _
& vbLf & vbLf & "(nom & prénom séparés par un espace)": Exit Sub
If sp = "" Then MsgBox "Veuillez indiquer la spécialité.": Exit Sub
Dim T, chn$, p%, n&, i&: LR = 0
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
T = .[A1].Resize(n, 19)
End With
For i = 2 To n
If T(i, 4) = NP Then
chn = T(i, 14)
If chn <> "" Then
p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1
If RTrim$(Left$(chn, p)) = sp Then LR = i: ShowPers T: Exit Sub
End If
End If
Next i
For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i
For i = 1 To 8: Controls("cbx" & Format(i, "00")) = "": Next i
End Sub
Private Sub UserForm_Initialize()
'N° Personnel
tbx01 = Format(Application.WorksheetFunction.Max(Worksheets("Feuil1").Columns(1)) + 1, "0000")
'liste cbx09 : Personnes (Nom et Prénom), sans doublons
Dim T, d, n&, i&
With Worksheets("Feuil1")
n = .Cells(Rows.Count, 4).End(3).Row: If n = 1 Then Exit Sub
T = .[D1].Resize(n)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To n
If T(i, 1) <> "" Then d(T(i, 1)) = ""
Next i
cbx09.List = d.Keys
'liste cbx10 : Spécialité
Dim chn$, p%, lig As Byte: lig = 1
With Worksheets("Feuil4")
Do
chn = .Cells(lig, 7): If chn = "" Then Exit Sub
p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1
cbx10.AddItem RTrim$(Left$(chn, p)): lig = lig + 1
Loop
End With
End Sub
Private Sub cmdExit_Click()
Application.ScreenUpdating = 0: Worksheets("Feuil3").Select: Unload Me
End Sub
Bonjour Soan,Bonjour nono79,
désolé pour t'avoir délaissé un très long moment, mais j'suis d'nouveau avec toi.je te retourne ton fichier modifié, où j'ai corrigé les 2 problèmes que tu as décrit dans tes 2 posts précédents ; j'ai aussi fait diverses améliorations concernant le format des données ; à l'ouverture du fichier, tu es sur "Feuil1" ; fais Ctrl e ➯ ouverture du formulaire UserForm1 ; à toi de faire les tests, pour le bouton Modifier, et aussi pour le bouton Valider.
code VBA complet de UserForm1 (193 lignes) :
VB:Option Explicit Const PWD$ = "nono79" '<--- mot de passe à changer (seulement à cet endroit) Dim LR& 'Ligne de la personne qui a été trouvée par la Recherche ; 0 = non trouvée Private Sub tbx03_Change() 'Date Début Dim lng As Byte: lng = Len(tbx03): If lng = 3 Or lng = 6 Then tbx03 = tbx03 & "/" End Sub Private Sub tbx04_Change() 'Date Fin Dim lng As Byte: lng = Len(tbx04): If lng = 3 Or lng = 6 Then tbx04 = tbx03 & "/" End Sub Private Sub tbx06_Change() 'Date Nais Dim lng As Byte: lng = Len(tbx06): If lng = 3 Or lng = 6 Then tbx06 = tbx03 & "/" End Sub Private Sub tbx10_Change() 'Date L Dim lng As Byte: lng = Len(tbx10): If lng = 3 Or lng = 6 Then tbx10 = tbx03 & "/" End Sub Private Sub tbx02_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'N° Groupe Dim Session$, Groupe%, T, k&, n&, i& Session = cbx01: Groupe = Val(tbx02): If Groupe = 0 Then Exit Sub With Worksheets("Feuil1") n = .Cells(Rows.Count, 2).End(3).Row: If n = 1 Then Exit Sub T = .[B1].Resize(n, 2) For i = 2 To n If Session = T(i, 2) And Groupe = T(i, 1) Then k = k + 1 Next i MsgBox "Session : " & Session & vbLf & vbLf & "Groupe " & Format(Groupe, "00") & " :" _ & vbLf & vbLf & Space$(8) & k & " personnes", 64, "Nombre de personnes" If k = 15 Then MsgBox "Vous ne pouvez pas dépasser 15 personnes par groupe." & vbLf & vbLf _ & "Veuillez créer un nouveau groupe.", 48, "15 personnes maximum" tbx02 = "": cbx01 = "": Cancel = -1 End If End With End Sub Private Sub cmdNew_Click() Dim i As Byte For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i For i = 1 To 10: Controls("cbx" & Format(i, "00")) = "": Next i End Sub Private Sub cmdModif_Click() If cbx09 = "" Then MsgBox "Veuillez sélectionner le nom/prénom de la personne à modifier.": Exit Sub If cbx10 = "" Then MsgBox "Veuillez sélectionner la spécialité de la personne à modifier.": Exit Sub If tbx05 = "" Then MsgBox "Merci de cliquer sur le bouton Recherche.": Exit Sub If LR = 0 Then Exit Sub Dim NP&, GR As Byte, SL As Byte: NP = Val(tbx01): GR = Val(tbx02): SL = Val(cbx03) With Worksheets("Feuil1") .Unprotect PWD With .Cells(LR, 1) .Value = Format(NP, "0000") 'N° Personnel .Offset(, 1) = Format(GR, "00") 'N° Groupe .Offset(, 2) = cbx01 'N° Sess .Offset(, 3) = tbx05 'Nom et Prénom .Offset(, 4) = cbx05 'Nom et Prénom (arabe) .Offset(, 5) = CDate(tbx06) 'Date Nais .Offset(, 6) = tbx07 'Lieu A / Lieu 2 .Offset(, 7) = cbx06 'Ville .Offset(, 8) = tbx08 'Adresse .Offset(, 9) = tbx09 'Entreprise A / Entreprise .Offset(, 10) = cbx08 'Permis .Offset(, 11) = CDate(tbx10) 'Date L .Offset(, 12) = tbx11 'Lieu B / Lieu 3 .Offset(, 13) = cbx07 'Spécialité .Offset(, 14) = CDate(tbx03) 'Date Début .Offset(, 15) = CDate(tbx04) 'Date Fin .Offset(, 16) = cbx02 'Entreprise B / Lieu 1 .Offset(, 17) = cbx04 'Prise en charge .Offset(, 18) = Format(SL, "00") 'N° Salle End With .Protect PWD: .Select End With End Sub Private Sub cmdValid_Click() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets ws.Protect Password:=PWD, UserInterfaceOnly:=True Next ws If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche) MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub End If If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD")) tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD")) Dim NP&, GR As Byte, SL As Byte, dlg&: dlg = Cells(Rows.Count, 1).End(3).Row GR = Val(tbx02): SL = Val(cbx03): NP = Val(tbx01): If NP > dlg Then NP = dlg With Worksheets("Feuil1").Cells(dlg + 1, 1) .Value = Format(NP, "0000") 'N° Personnel .Offset(, 1) = Format(GR, "00") 'N° Groupe .Offset(, 2) = cbx01 'N° Sess .Offset(, 3) = tbx05 'Nom et Prénom .Offset(, 4) = cbx05 'Nom et Prénom (arabe) .Offset(, 5) = CDate(tbx06) 'Date Nais .Offset(, 6) = tbx07 'Lieu A / Lieu 2 .Offset(, 7) = cbx06 'Ville .Offset(, 8) = tbx08 'Adresse .Offset(, 9) = tbx09 'Entreprise A / Entreprise .Offset(, 10) = cbx08 'Permis .Offset(, 11) = CDate(tbx10) 'Date L .Offset(, 12) = tbx11 'Lieu B / Lieu 3 .Offset(, 13) = cbx07 'Spécialité .Offset(, 14) = CDate(tbx03) 'Date Début .Offset(, 15) = CDate(tbx04) 'Date Fin .Offset(, 16) = cbx02 'Entreprise B / Lieu 1 .Offset(, 17) = cbx04 'Prise en charge .Offset(, 18) = Format(SL, "00") 'N° Salle .Parent.Select End With Unload UserForm1: UserForm1.Show End Sub Private Sub ShowPers(T) tbx01 = Format(T(LR, 1), "0000") 'N° Personnel tbx02 = T(LR, 2) 'N° Groupe cbx01 = T(LR, 3) 'N° Sess tbx05 = T(LR, 4) 'Nom et Prénom cbx05 = T(LR, 5) 'Nom et Prénom (arabe) tbx06 = T(LR, 6) 'Date Nais tbx07 = T(LR, 7) 'Lieu A / Lieu 2 cbx06 = T(LR, 8) 'Ville tbx08 = T(LR, 9) 'Adresse tbx09 = T(LR, 10) 'Entreprise A / Entreprise cbx08 = T(LR, 11) 'Permis tbx10 = T(LR, 12) 'Date L tbx11 = T(LR, 13) 'Lieu B / Lieu 3 cbx07 = T(LR, 14) 'Spécialité tbx03 = T(LR, 15) 'Date Début tbx04 = T(LR, 16) 'Date Fin cbx02 = T(LR, 17) 'Entreprise B / Lieu 1 cbx04 = T(LR, 18) 'Prise en charge cbx03 = T(LR, 19) 'N° Salle Worksheets("Feuil1").Select End Sub Private Sub cmdSearch_Click() Dim NP$, sp$: NP = cbx09: sp = cbx10 If NP = "" Then MsgBox "Veuillez indiquer la personne recherchée." _ & vbLf & vbLf & "(nom & prénom séparés par un espace)": Exit Sub If sp = "" Then MsgBox "Veuillez indiquer la spécialité.": Exit Sub Dim T, chn$, p%, n&, i&: LR = 0 With Worksheets("Feuil1") n = .Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub T = .[A1].Resize(n, 19) End With For i = 2 To n If T(i, 4) = NP Then chn = T(i, 14) If chn <> "" Then p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1 If RTrim$(Left$(chn, p)) = sp Then LR = i: ShowPers T: Exit Sub End If End If Next i For i = 1 To 11: Controls("tbx" & Format(i, "00")) = "": Next i For i = 1 To 8: Controls("cbx" & Format(i, "00")) = "": Next i End Sub Private Sub UserForm_Initialize() 'N° Personnel tbx01 = Format(Application.WorksheetFunction.Max(Worksheets("Feuil1").Columns(1)) + 1, "0000") 'liste cbx09 : Personnes (Nom et Prénom), sans doublons Dim T, d, n&, i& With Worksheets("Feuil1") n = .Cells(Rows.Count, 4).End(3).Row: If n = 1 Then Exit Sub T = .[D1].Resize(n) End With Set d = CreateObject("Scripting.Dictionary") For i = 2 To n If T(i, 1) <> "" Then d(T(i, 1)) = "" Next i cbx09.List = d.Keys 'liste cbx10 : Spécialité Dim chn$, p%, lig As Byte: lig = 1 With Worksheets("Feuil4") Do chn = .Cells(lig, 7): If chn = "" Then Exit Sub p = InStr(chn, "/"): If p = 0 Then p = Len(chn) Else p = p - 1 cbx10.AddItem RTrim$(Left$(chn, p)): lig = lig + 1 Loop End With End Sub Private Sub cmdExit_Click() Application.ScreenUpdating = 0: Worksheets("Feuil3").Select: Unload Me End Sub
si besoin, tu peux demander une autre adaptation.
à te lire pour avoir ton avis.
soan
Bonjour Soan, voila je reviens vers toi;Bonsoir nono79,
je m'étais absenté, j'viens d'reprendre sur mon PC et de lire ton post #23 ; merci pour ton retour, et j'suis ravi que ma solution te convienne.(j'ai lu aussi ton MP, et je t'en remercie aussi. )
soan
bonjour Soan je m'excuse pour ce dérangement, l'ordre chronologique des opérations, à partir de Ctrl e pour afficher le formulaire UserForm1 jusqu'à le bouton validé :Bonjour nono79,
je n'ai pas réussi à reproduire ce qui cause ton erreur ; peux-tu m'indiquer tout ce que tu as fait ? quelles sont toutes les données que tu as saisi directement, ou par un choix dans une liste, ou suite à une Recherche ? indique-moi toute la procédure que tu suis dans l'ordre chronologique des opérations, à partir de Ctrl e pour afficher le formulaire UserForm1.
Regarde la pièce jointe 1102128
au départ : n° de la dernière ligne utilisée : 33 ; N° Pers : 0032 ; en D33 : Mouhamed ; voici tout ce que j'ai fait : Ctrl e ➯ affichage du formulaire UserForm1 ; j'ai fait une Recherche avec : "SAYAH Mohamed" et "Transport de personnes" ; pour Entreprise, j'ai mis "Bata1" au lieu de "Bata" ; clic sur bouton Valider ; clic sur bouton Oui pour confirmer l'ajout de données ➯ ça s'écrit en ligne 34, sans avoir écrasé la ligne 33 ; puis j'ai fait une Recherche avec : "Salem Mohamed" et "Transport de marchandises" ; pour Entreprise, j'ai mis "Bata2" au lieu de "Bata" ; clic sur bouton Valider ; clic sur bouton Oui pour confirmer l'ajout de données ➯ ça s'écrit en ligne 35, sans avoir écrasé la ligne 34 (ni les précédentes).
Regarde la pièce jointe 1102129
en comparant les 2 images, tu peux voir que les lignes 31 à 33 sont restées inchangées, y compris la ligne 33 de Mouhamed ; N° Pers identique : 0032 ; Groupe identique : 02 ; Entreprise A identique : SO ; autres infos de cette ligne 33 : pas de changement, donc pas d'écrasement.
soan
Private Sub cmdValid_Click()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=PWD, UserInterfaceOnly:=True
Next ws
If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche)
MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub
End If
If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub
tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD"))
tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD"))
Dim NP&, GR As Byte, SL As Byte, dlg&
With Worksheets("Feuil1")
dlg = .Cells(Rows.Count, 1).End(3).Row
GR = Val(tbx02): SL = Val(cbx03): NP = Val(tbx01): If NP > dlg Then NP = dlg
With .Cells(dlg + 1, 1)
.Value = Format(NP, "0000") 'N° Personnel
.Offset(, 1) = Format(GR, "00") 'N° Groupe
.Offset(, 2) = cbx01 'N° Sess
.Offset(, 3) = tbx05 'Nom et Prénom
.Offset(, 4) = cbx05 'Nom et Prénom (arabe)
.Offset(, 5) = CDate(tbx06) 'Date Nais
.Offset(, 6) = tbx07 'Lieu A / Lieu 2
.Offset(, 7) = cbx06 'Ville
.Offset(, 8) = tbx08 'Adresse
.Offset(, 9) = tbx09 'Entreprise A / Entreprise
.Offset(, 10) = cbx08 'Permis
.Offset(, 11) = CDate(tbx10) 'Date L
.Offset(, 12) = tbx11 'Lieu B / Lieu 3
.Offset(, 13) = cbx07 'Spécialité
.Offset(, 14) = CDate(tbx03) 'Date Début
.Offset(, 15) = CDate(tbx04) 'Date Fin
.Offset(, 16) = cbx02 'Entreprise B / Lieu 1
.Offset(, 17) = cbx04 'Prise en charge
.Offset(, 18) = Format(SL, "00") 'N° Salle
End With
.Select
End With
Unload UserForm1: UserForm1.Show
End Sub
Bonjour Soan;Bonjour nono79,
tu as bien décrit la procédure.problème réglé avec cette nouvelle sub :
VB:Private Sub cmdValid_Click() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets ws.Protect Password:=PWD, UserInterfaceOnly:=True Next ws If cbx05 = "" And cbx09 = "" Then 'Nom/Prénom (arabe) & Nom/Prénom (recherche) MsgBox "Veuillez renseigner les champs 'Nom/Prénom' ": Exit Sub End If If MsgBox("confirmez-vous l'ajout des données ?", 4, "confirmation") <> 6 Then Exit Sub tbx03 = Format(tbx03, ("YYYY/MM/DD")): tbx04 = Format(tbx04, ("YYYY/MM/DD")) tbx06 = Format(tbx06, ("YYYY/MM/DD")): tbx10 = Format(tbx10, ("YYYY/MM/DD")) Dim NP&, GR As Byte, SL As Byte, dlg& With Worksheets("Feuil1") dlg = .Cells(Rows.Count, 1).End(3).Row GR = Val(tbx02): SL = Val(cbx03): NP = Val(tbx01): If NP > dlg Then NP = dlg With .Cells(dlg + 1, 1) .Value = Format(NP, "0000") 'N° Personnel .Offset(, 1) = Format(GR, "00") 'N° Groupe .Offset(, 2) = cbx01 'N° Sess .Offset(, 3) = tbx05 'Nom et Prénom .Offset(, 4) = cbx05 'Nom et Prénom (arabe) .Offset(, 5) = CDate(tbx06) 'Date Nais .Offset(, 6) = tbx07 'Lieu A / Lieu 2 .Offset(, 7) = cbx06 'Ville .Offset(, 8) = tbx08 'Adresse .Offset(, 9) = tbx09 'Entreprise A / Entreprise .Offset(, 10) = cbx08 'Permis .Offset(, 11) = CDate(tbx10) 'Date L .Offset(, 12) = tbx11 'Lieu B / Lieu 3 .Offset(, 13) = cbx07 'Spécialité .Offset(, 14) = CDate(tbx03) 'Date Début .Offset(, 15) = CDate(tbx04) 'Date Fin .Offset(, 16) = cbx02 'Entreprise B / Lieu 1 .Offset(, 17) = cbx04 'Prise en charge .Offset(, 18) = Format(SL, "00") 'N° Salle End With .Select End With Unload UserForm1: UserForm1.Show End Sub
soan