Formulaire de saisie avec calcul de date

[Monhtc]

Bonjour chers tous,
après mainte recherche je me tourne vers vous en espérant trouver solution pour terminer mon formulaire.

1/ Déterminer une série de jours ouvrés avant et après un weekend ou un jour férie à partir d'une date début. (option samedi et dimanche pris en charge dans les cas exceptionnel)
EXEMPLE: POUR UNE PÉRIODE DU 25 AVRIL AU 30 AVRIL; COMMENT OBTENIR
PERIODE 1: Date de début: 25 Avril - Date de fin: 26 Avril
PERIODE 2: Date de début: 29 Avril - Date de fin: 30 Avril

2/
a/J'aimerais créer une liste déroulante dynamique (les combox1, les combox2 et les combox3) avec condition de sorte à ce que si le nom entré ne figure pas préalablement dans la liste source, il soit accepté et s'y rajoute dans la base. (Tableau lié a la Feuil3)
b/les combox1, les combox2 et les combox3 étant liés si l'un est tapé sa correspondance s'affichent automatiquement dans les autres (comme les formules RECHERCHE V et INDEX EQUIV)

 

[Staple1600]

Bonjour le fil,

Monhtc
Avec ou sans notre accord, tu peux joindre ton fichier (penses bien à l’anonymiser avant )
Encore faut-il le joindre
Ce qui ne semble pas être le cas dans ton précédent message...

 

[Monhtc]

Merci @Staple1600 merci aussi a @job75 qui l'a redigé depuis

Voici le code que j'ai adapté pour mes combobox mais il ne marche pas correctement. Je voudrais qu'il accepte toutesles nouvelles entrées qui n existe pas préalablement et les rajoute à la base sur la feuil3 "Config"

Private Sub boxnom_AfterUpdate()
If boxnom.ListIndex > -1 Then Exit Sub
If MsgBox("Ajouter ce Nom à la liste des employés?", 4) = 7 Then boxnom = "": Exit Sub
[EMPLOYES].Cells(Application.CountA([EMPLOYES]) + 1) = boxnom
boxnom.List = [EMPLOYES].cells(3).Resize(Application.CountA([EMPLOYES]) - 1, 2).Value
End Sub

Private Sub boxfonction_AfterUpdate()
If boxfonction.ListIndex > -1 Then Exit Sub
If MsgBox("Modifier la fonction de cet employé ?", 4) = 7 Then boxfonction = "": Exit Sub
[FONCTION].Cells(Application.CountA([FONCTION]) + 1) = boxfonction
boxfonction.List = [FONCTION].cells(3).Resize(Application.CountA([FONCTION]) - 1, 2).Value
End Sub

Private Sub boxcontact_AfterUpdate()
If boxcontact.ListIndex > -1 Then Exit Sub
If MsgBox("Attribuer ce contact à cet employé ?", 4) = 7 Then boxcontact = "": Exit Sub
[CONTACTS].Cells(Application.CountA([CONTACTS]) + 1) = boxcontact
boxcontact.List = [CONTACTS].cells(3).Resize(Application.CountA([CONTACTS]) - 1, 2).Value
End Sub

Voici ensuite mon code suivant pour enregistrer

Private Sub enregistrer_Click()
'PROBLEME BEUG AVEC CE CODE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If boxnom = "" Then boxnom.SetFocus: boxnom.DropDown: Exit Sub
If boxfonction = "" Then boxfonction.SetFocus: boxfonction.DropDown: Exit Sub
If boxcontact = "" Then boxcontact.SetFocus: boxcontact.DropDown: Exit Sub
If boxlieu = "" Then boxlieu.SetFocus: boxlieu.DropDown: Exit Sub
If Not IsDate(boxdepart) Then boxdepart.SetFocus: boxdepart = "": Exit Sub
If Not IsDate(boxdretour) Then boxdretour.SetFocus: boxdretour = "": Exit Sub
If boxtransport = "" Then boxtransport.SetFocus: boxtransport.DropDown: Exit Sub
Dim deb As Date, fin As Date, Samedi As Boolean, dimanche As Boolean, lig&, dat, n&
deb = Application.Min(CDate(boxdepart), CDate(boxdretour))
fin = Application.Max(CDate(boxdepart), CDate(boxdretour))
TextBox1 = deb: boxdretour = fin 'en cas d'inversion
Samedi = Samedi: dimanche = dimanche
n = 0: lig = 17
Rows("17:" & Rows.Count).Delete 'RAZ
For dat = deb To fin
    If (Weekday(dat) < 7 Or Samedi) And (Weekday(dat) > 1 Or dimanche) And Application.CountIf([Feries], dat) = 0 Then
        If Cells(lig - 1, "D") = dat - 1 Then
            Cells(lig - 1, "D") = dat
        Else
            n = n + 1
            Cells(lig, "B").Resize(2).Merge
            Cells(lig, "B") = "PERIODE " & n
            Cells(lig, "C") = "DATE DE DEPART"
            Cells(lig + 1, "C") = "DATE DE RETOUR"
            Cells(lig, "D").Resize(2) = dat
            lig = lig + 2
        End If
    End If
Next
If lig = 19 Then
    [C17:C18].Cut [B17]
    [B17:C17].Merge
    [B18:C18].Merge
End If
For n = 1 To 4: Cells(12 + n, "D") = Controls("ComboBox" & n): Next
Cells(lig, "B").Resize(, 2).Merge
Cells(lig, "B") = "TRANSPORT"
Cells(lig, "D") = boxbudget
If lig > 17 Then Range(Cells(17, "D"), Cells(lig - 1, "D")).NumberFormat = "dddd d mmmm yyyy"
Range(Cells(17, "B"), Cells(lig, "D")).Borders.Weight = xlMedium
End Sub
If boxnom = "" Or boxcontact = "" Or boxfonction = "" Or boxlieu = "" Or boxobjet = "" Or boxdepart = "" Or boxretour = "" Or boxtransport = "" Or boxbudget = "" Or boxsignature = "" Then
MsgBox ("Veuillez entrer toutes les informations")
Else
If Sheets(2).Range("A2") = "" Then
   Sheets(2).Range("A2") = om
   Else
   Sheets(2).ListObjects(1).ListRows.Add
   End If
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   'SAUVEGARDE DE LA BASE DE DONNEES SUR LA FEUILLE 2 POUR DES RECHERCHES ULTERIEURES
   dlign = Sheets(2).Range("d1048576").End(xlUp).Row
 
   Sheets(2).Range("A" & dlign) = om
   Sheets(2).Range("B" & dlign) = boxnom
   Sheets(2).Range("C" & dlign) = boxfonction
   Sheets(2).Range("D" & dlign) = boxcontact
   Sheets(2).Range("E" & dlign) = boxlieu
   Sheets(2).Range("F" & dlign) = boxobjet
   Sheets(2).Range("G" & dlign) = boxtransport
   Sheets(2).Range("H" & dlign) = boxdepart
   boxdepart = Format(boxdepart, "dd/mmm/yy")
   Sheets(2).Range("I" & dlign) = boxretour
   boxretour = Format(boxretour, "dd/mmm/yy")
   Sheets(2).Range("J" & dlign) = boxbudget
   Sheets(2).Range("K" & dlign) = boxsignature

 
End If
UserForm_Initialize
Sheets(3).Range("F2").Value = Sheets(3).Range("F2").Value + 1
End Sub

 

[Monhtc]

Bonjour b

@ Nosma ne squattez pas ce fil, créez une nouvelle discussion et soyez beaucoup plus explicite !

@ Monhtc voyez le code de l'UserForm dans le fichier joint.

Bonjour Bonsoir @job75
J'ai progressé sur le fichier en ajoutant deux textbox (TextBox3 et TextBox4) sauf que j'ai du mal à les disposer sur la feuille imprimer juste en bas de "lieu".
Par ailleurs je cherche toujours à lier les cellules combobox1, 2 et 3.

 

[JM27]

Bonjour
il serait correct de répondre aux propositions que l'on te fait sur un autre fil
d'autant plus que cela répond à ta question ( a priori)
https://www.excel-downloads.com/threads/saisie-automatique-combobox.20033572/

voir
https://www.excel-downloads.com/help/charte/

point 6 particulièrement

Edit: je viens d'avoir une réponse sur l'autre fil

 

[Monhtc]

Je tourne en rond tout en cherchant une solution pour peaufiner et avancer sur mon code