XL 2013 Bouton validé enregistrement avec condition

nono79 · 9 Février 2021

Bonjour le forum;

j'ai besoin de votre aide si c'est possible bien sur, j'ai un userform qui contient des combobox et des textbox, combobox = numéro de session et la textbox = numero du groupe, voila je veux quand je saisie a la validation un contrôle s'effectue comme suit :
une session contient plusieurs groupes, une groupe ne doit pas dépasser les 15 personnes.
Exemple: numero de session = /S01/16/2021

je m'explique, une session peut contenir plusieurs groupes, le groupe ne doit pas dépasser les 15 personnes dans une salle.

Exemple :

Session 01 /S01/16/2021 = Groupe 1 = 15 personnes = salle 01

Session 01/S01/16/2021 = Groupe 2 = 15 personnes = salle 02

Session 01/S01/16/2021 = Groupe N = 15 personnes = salle N

Session 02/S02/16/2021 = Groupe 1 = 15 personnes = salle 01 ainsi de suite.

Si le Groupe 01 = 15 personnes, si je dépasse les 15 personnes un message s'affiche " vous pouvez pas dépasser 15 personnes par groupe veuillez créer un nouveau groupe"

je vous remercie d'avance.
bonne journée .

nono79 · 16 Février 2021

nono79 à dit:
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

bonjour;
j'ai un autre souci si tu peux m'aider bien sur, voila c'est à-propos du bouton recherche, car quand je fait une recherche, c'est toujours le 1er enregistrement qui sort, je veux que la recherche soit sur deux critères le nom et prénom plus la spécialité.
merci d'avance.

soan · 17 Février 2021

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

nono79 · 18 Février 2021

soan à dit:

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;
je suis vraiment très reconnaissant pour tous le travail que tu a fait, c'est impeccable super

, je l'ai tester et je le trouve très bien

, j'essaie de l'adapter sur d'autres userform, si je n'arrive pas est ce que c'est possible de retourner vers toi?, si tu me le permet bien sur.
a très bientôt et ravie de te lire une autre fois.
bonne continuation.

soan · 18 Février 2021

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

nono79 · 25 Février 2021

bonjour soan;
je reviens vers toi comme toujours, j'ai pu adapté le code sur d'autre userform, mais je rencontre d'autres problèmes, pour cela comme d'habitude si tu peux et tu veux bien m'aidé.
le problème est au niveau du bouton modifier et enregistrer,
je m'explique
1- le bouton modifier : quand je fait une recherche d'un enregistrement je le trouve, quand je modifier une textbox ou bien un combobx c'est pas le meme enregistrement qui est modifier mais le 1 er exmple :
dans le BD t'inquiète pas elle est fictive il y a deux enregistrement qui ont le même nom N°1 et N°25 mais pas la même spécialité, quand je fait une modification sur l'enregistrement N°25 sa sauvegarde elle écrase l'enregistrement N°1 et le 25 reste inchangé.
2- le bouton enregistrer : quand je fait une recherche d'un enregistrement je le trouve, quand je modifier une textbox ou bien un combobx et je veux l'enregistrer tout en changent le N° personnels ont prenants le dernier N° attribuer automatiquement, message d'erreur.
je te remercie d'avance comme toujours, et a très bientôt
veuillez trouver le fichier en pièce jointe.

nono79 · 8 Mars 2021

soan à dit:
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

bonjour soan;
je reviens vers toi comme toujours, j'ai pu adapté le code sur d'autre userform, mais je rencontre d'autres problèmes, pour cela comme d'habitude si tu peux et tu veux bien m'aidé.
le problème est au niveau du bouton modifier et enregistrer,
je m'explique
1- le bouton modifier : quand je fait une recherche d'un enregistrement je le trouve, quand je modifier une textbox ou bien un combobx c'est pas le meme enregistrement qui est modifier mais le 1 er exmple :
dans le BD t'inquiète pas elle est fictive il y a deux enregistrement qui ont le même nom N°1 et N°25 mais pas la même spécialité, quand je fait une modification sur l'enregistrement N°25 sa sauvegarde elle écrase l'enregistrement N°1 et le 25 reste inchangé, je veux que la modification soit porté sur l'enregistrement N°25.
2- le bouton enregistrer : quand je fait une recherche d'un enregistrement je le trouve, quand je modifier une textbox ou bien un combobx et je veux l'enregistrer tout en changent le N° personnels ont prenants le dernier N° attribuer automatiquement, message d'erreur.
je te remercie d'avance comme toujours, et a très bientôt
veuillez trouver le fichier en pièce jointe.

soan · 10 Avril 2021

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

nono79 · 12 Avril 2021

soan à dit:

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,
Je tiens à t'envoyer ce petit message pour te remercier de m'avoir aidé dans ce projet. Je crois, réellement, que sans toi cela n'aurait pas été possible. j'aime bien l'idée de prendre mon temps, pour te dire merci comme il le faut, à la hauteur de ce que je ressens.
Avec toute la sincérité possible, tu dois savoir que je m'engage à tout mettre en œuvre pour te rendre la pareille. Je crois vraiment à ce qui nous permet de construire un monde meilleur, pour moi, c'est d'abord de se rendre des services les uns les autres avec l'envie de bien faire. Je te suis très reconnaissant d'incarner cela.
Merci à toi, sache que tu m'as tiré une sacrée épine du pied.
Merci encore une fois de plus et a bientôt.

soan · 12 Avril 2021

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

nono79 · 13 Avril 2021

soan à dit:
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, voila je reviens vers toi;
après avoir fait le test il y a toujours le problème au niveau du bouton validé d'où le 1 er enregistrement se valide sans problème, mais des le 2 eme enregistrement le numéro personnel il s'arrête de s'incrémenté et il écrase le 1 er enregistrement.
ci-joint le fichier dans j'ai fait le test.
Comme d'habitude merci pour tous, si tu n'ai pas trop pris par le temps, j'attends ta réponse si c'est possible .

soan · 14 Avril 2021

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.

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

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

nono79 · 15 Avril 2021

soan à dit:
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

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é :
au départ : n° de la dernière ligne utilisée : 32 ; N° Pers : 0031 ; en D32 : hamiche samir; voici ce que j'ai fait : Ctrl e affichage du formulaire UserForm1, j'ai commencé a saisir un nouveau enregistrement, j'ai remplis tout les textbox et les combobox une fois terminer, clic sur bouton Valider ; clic sur bouton Oui pour confirmer l'ajout de données, pour la ligne 33 et 34 ça c'est écrit et enregistrer très bien, des que je ferme le fichier et je l'ouvre une autre fois, je saisie un nouveau enregistrement, normalement il s'enregistre à la ligne 35, mais la il écrase le 1 er enregistrement qui se trouve a la ligne 02.
je te joint le fichier.
merci d'avance.

soan · 17 Avril 2021

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

nono79 · 18 Avril 2021

soan à dit:

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

Bonjour Soan;
je te remercie pour ta réponse, c'est je que je cherché exactement.
merci beaucoup et bonne continuation.

soan · 18 Avril 2021

Bonjour nono79,

merci pour ton retour !

ce sujet est donc finalement résolu !

bonne continuation à toi aussi.

soan

XL 2013 Bouton validé enregistrement avec condition

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums