Date j+1, j+2 dans textbox en fonction d'optionbutton

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je cherche un code pouvant, selon la sélection d'un optionbutton afficher une date j+1 ou j+2 ou ouverture d'un calendrier pour sélection d'un jour personnalisé.

En sélectionnant priorité basse : J+2 (en élminant les jours fériés, samedi et dimanche)
Moyenne et haute : J+1 (en élminant les jours fériés, samedi et dimanche)

Pièce jointe 197418

Voici mon code fonctionnel :

Le cmdCancel_Click annule et relance le formulaire
Le cmdConfirm_Click envoie les données récoltées du userform vers ma plage de données
Le CommandButton26_Click intialise mon numéro de dossier

Merci pour vos indiactions :-)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Private Sub cmdCancel_Click()
Dim Ctrl As Control
    'efface textbox
    For Each Ctrl In Me.Controls("Frame1").Controls
        If TypeName(Ctrl) = "TextBox" Then
            Select Case Ctrl.Name
            Case Else
                Ctrl.Value = ""
            End Select
        End If
    Next
    'efface optionbutton
    For Each Ctrl In Me.Controls("Frame1").Controls
        If TypeName(Ctrl) = "OptionButton" Then Ctrl.Value = False
    Next Ctrl
 
    For Each Ctrl In Me.Controls("Frame1").Controls
        If TypeName(Ctrl) = "ComboBox" Then
            Select Case Ctrl.Name
            Case Else
                Ctrl.Value = ""
            End Select
        End If
    Next
 
End Sub
 
Sub cmdConfirm_Click()
Dim Ctrl As Control
Dim Ctrl1 As Control
 
 
 Sheets("DATA").Activate
 
 
  'Positionnement dans la table
  [A65000].End(xlUp).Offset(1, 0).Select
  'Transfert des données formulaire dans BD
  'frame priorité
  ActiveCell.Value = Application.Proper(Me.NumCall)
 
  For Each Ctrl In Frame2.Controls
        If Ctrl.Object.Value = True Then
             ActiveCell.Offset(0, 1).Value = Ctrl.Object.Caption
            Exit For
        End If
    Next Ctrl
  ActiveCell.Offset(0, 2).Value = Me.txtDate
  ActiveCell.Offset(0, 3).Value = Me.ActionAgent
  ActiveCell.Offset(0, 4).Value = Me.ComboTypeCall
  ActiveCell.Offset(0, 5).Value = Me.ResaCmde
  ActiveCell.Offset(0, 6).Value = Me.Outbound
  ActiveCell.Offset(0, 7).Value = Me.Article
  ActiveCell.Offset(0, 8).Value = Me.Lot
  ActiveCell.Offset(0, 9).Value = Me.Objet
 
  'rafraichi frame
 
    'efface textbox
    For Each Ctrl1 In Me.Controls("Frame1").Controls
        If TypeName(Ctrl1) = "TextBox" Then
            Select Case Ctrl1.Name
            Case Else
                Ctrl1.Value = ""
            End Select
        End If
    Next
    'efface optionbutton
    For Each Ctrl1 In Me.Controls("Frame1").Controls
        If TypeName(Ctrl1) = "OptionButton" Then Ctrl1.Value = False
    Next Ctrl1
 
    For Each Ctrl1 In Me.Controls("Frame1").Controls
        If TypeName(Ctrl1) = "ComboBox" Then
            Select Case Ctrl1.Name
            Case Else
                Ctrl1.Value = ""
            End Select
        End If
    Next
 
    'recharge la date du jour
    txtDate.Value = Date
 
    'message fin
    MsgBox "Call créé", vbInformation, "Création du call"
 
    'cacher bouton valider ticket
    cmdConfirm.Visible = False
 
    'relance
End Sub
 
 
Private Sub CommandButton26_Click()
NumCall.Value = Format(Now, "ddmmyyyyhhnnss")
cmdConfirm.Visible = True
 
End Sub
 
Private Sub UserForm_Initialize()
 
    'charge la date du jour (non visible)
    txtDate.Value = Date
 
    'cacher bouton valider ticket
    cmdConfirm.Visible = False
 
    'Type de demande
    ComboTypeCall.AddItem "demande urgente"
    ComboTypeCall.AddItem "demande anticipée"
    ComboTypeCall.AddItem "information(s)"
    ComboTypeCall.AddItem "recyclage"
    ComboTypeCall.AddItem "annulation de commande"
    ComboTypeCall.AddItem "modification Master data"
    ComboTypeCall.AddItem "matériel magasin"
    ComboTypeCall.AddItem "urgence SAE"
 
 
End Sub

Bonjour,

Une solution possible dans ce fichier Pièce jointe 197587 où j'utilise des contrôles DtPicker pour les dates.

Elle est basée sur une fonction construite par Laurent LONGRE pour trouver les jours fériés en France, donc à adapter pour la Belgique (Je pense que les anciens du MPFE de ce forum, l'auront adaptée).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
' Fonction construite par Laurent LONGRE
' Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
' 1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
' Valide jusqu'en 2099 et pour les jours fériés français
 
 
Function TYPEJOUR(D As Date)
'Laurent Longre
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
 
    A = Year(D)
    If A > 2099 Then
        TYPEJOUR = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TYPEJOUR = 2
        Exit Function
    End If
 
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + T + (T > 48) + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    Select Case D
        ' Jours fériés mobiles
        Case Is = LP, Is = LP + 38, Is = LP + 49
            TYPEJOUR = 2
        ' Jours fériés fixes
        Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
            Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
            Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
            Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
                TYPEJOUR = 2
        Case Else
        ' Samedi ou dimanche
            If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
    End Select
 
End Function

Dans le module1, j'ai ajouté le code suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit
 
Public Const DelaiPrioriteBasse As Integer = 2
Public Const DelaiPrioriteHaute As Integer = 1
 
Sub TrouverLaDate()
 
    With UserForm1
 
         .OptionButtonPrioriteBasse = True
         .DTPickerDateProposee = DateProposable(Date, True)
         .Show
 
    End With
 
 
End Sub
 
 
Function DateProposable(ByVal DateDuJour As Date, ByVal PrioriteBasse As Boolean) As Date
 
          Select Case PrioriteBasse
                 Case True
                      For DateProposable = DateDuJour + DelaiPrioriteBasse To DateDuJour + 10
                          If TYPEJOUR(DateProposable) = 0 Then
                             Exit Function
                          End If
                      Next DateProposable
                 Case False
                      For DateProposable = DateDuJour + DelaiPrioriteHaute To DateDuJour + 10
                          If TYPEJOUR(DateProposable) = 0 Then
                             Exit Function
                          End If
                      Next DateProposable
          End Select
 
End Function

Le code dans Userform1 est le suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Option Explicit
 
 
Private Sub BoutonRetour_Click()
        Unload UserForm1
End Sub
 
Private Sub DTPickerDateDuJour_Change()
  Select Case OptionButtonPrioriteBasse
         Case True
              DTPickerDateProposee = DateProposable(DTPickerDateDuJour, True)
         Case False
              DTPickerDateProposee = DateProposable(DTPickerDateDuJour, False)
  End Select
End Sub
 
Private Sub OptionButtonPrioriteBasse_Click()
        DTPickerDateProposee = DateProposable(DTPickerDateDuJour, True)
End Sub
 
Private Sub OptionButtonPrioriteHaute_Click()
        DTPickerDateProposee = DateProposable(DTPickerDateDuJour, False)
End Sub
 
Private Sub OptionButtonPrioriteMoyenne_Click()
        DTPickerDateProposee = DateProposable(DTPickerDateDuJour, False)
End Sub

Un exemple par rapport à notre 14 juillet :

Pièce jointe 197589

Cordialement.

11/01/2016, 09h10
dedam

Bonjour Eric,

Merci pour les informations et pour l'exemple !!

Je te reviens les yeux rempli de larmes .. :roll:.

J'ai un soucis avec les contrôles supplémentaires .. je n'ai pas accès à la modification du disque C:, du coup je ne sais pas activer le controle supplémentaire pour me servir du datepicker.
Est-il posssible, sur base de ce même code de me servir plûtot d'un textbopx ou bien d'un calendar ?

Bien à toi,

Damien
11/01/2016, 09h19
Invité

Citation:

Envoyé par dedam

Est-il posssible, sur base de ce même code de me servir plûtot d'un textbopx ou bien d'un calendar ?

Bonjour,

Pas de soucis, il suffit que le contenu du textbox soit bien une date (Cdate(textbox)).

Nb : Si mon outil a fonctionné sur votre PC, c'est qu'il manque une référence VBA dans votre fichier. Pour vérifier, Alt-F11 puis dans le menu de l'éditeur VBA Outils puis Réference et comparer les références entre les deux fichiers.

Cordialement.

L'outil n'a pas fonctionné; il génère des erreur de type "erreur système &h80004005(-2147467259)" et les solutions proposées je ne puis les appliquer car je n'ai aps les droits suffisant (système de restriction des droits en entrprise :weird:).

Du coup, pour adapter le code, je boite un peu avec les commandes qui sont, pour le novice que je suis, compliquées.

En sachant que mes deux textbox, je n'ai pas changé les noms pour ne pas m'emmeler les pinceaux, se nomment pour la date du jour "DTPickerDateDuJour" et pour la date proposée "DTPickerDateProposee"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Private Sub DTPickerDateDuJour_Change() Select Case OptionButtonPrioriteBasse Case True DTPickerDateProposee = (CDate(DTPickerDateDuJour)) Case False DTPickerDateProposee = (CDate(DTPickerDateDuJour)) End Select End Sub Private Sub OptionButtonPrioriteBasse_Click() DTPickerDateProposee = (CDate(DTPickerDateDuJour)) End Sub Private Sub OptionButtonPrioriteHaute_Click() DTPickerDateProposee = DateProposable(DTPickerDateDuJour, False) End Sub Private Sub OptionButtonPrioriteMoyenne_Click() DTPickerDateProposee = DateProposable(DTPickerDateDuJour, False) End Sub
Quand j'entre une date manuellement "11/01/2016" en mettant le dernier chiffre "6", j'ai un erreur de type erreur d'exécution 13"incompatibilité de type". qui pointe vers
Code:

1 2 Case False DTPickerDateProposee = (CDate(DTPickerDateDuJour))
Sinon, avant l'erreur, on me propose bien une date .. aussi loufique soit-elle mais je devrai, à ce niveau parvenir à paramétrer ça par après

D'avance, merci

Damien

11/01/2016, 11h44
Invité

Une version avec des textbox. J'y ai ajouté des labels pour identifier le jour de la semaine dans le Userform Pièce jointe 197669

Cordialement.
11/01/2016, 12h01
dedam

Génial !!

C'est vraiment ce que j'espérais.

Un grand merci.

Damien