Dispatching NOM Prénom dans les onglets suivant Dates

**roby68** · 06/06/2020, 02h32

Bonjour,

Je suis coincé sur le dispatching du NOM Prénom dans les onglets Jaunes et Bleus.
J'aimerais, lorsque l'on valide la saisie ( UserForm = frmIDPPSMJ ), que le NOM et Prénom ( colonne C ) s'inscrive dans les onglet en jaune et en bleu suivant deux dates ( * ).

Exemple : NOM Prénom 01

Date Pose ( inscription dans les onglets couleur Jaune ) ici 02/06/2020 dans l'onglet Pose 06
et
Date Théorique ( inscription dans les onglets couleur Bleu ) ici 02/09/2020 dans l'onglet Fin 09

Où cela se complique, c'est lorsque l'on veut modifier et faire apparaitre le NOM Prénom 05 pour l'exemple, dans les onglets couleur bleu toujours, cette fois pas à l'aide de la date Théorique mais avec la Date réelle fin en n'oubliant pas d'effacer la correspondance Date Théorique saisie auparavant ( bouton Modifier pour cette tâche dans l'UserForm avec les données déjà existantes).

Merci d'avance Roby

**mfoxy** · 06/06/2020, 11h33

Bonjour,

Très peu de membres ouvrent les pièces jointes.
Pour des raisons évidentes de sécurités.

Il serait préférable que vous postiez : votre code actuel , des explications simples, qq printscreen de vos tables in/out, nom de feuille,...

Bav

**ARTURO83** · 07/06/2020, 07h39

Bonjour,

Si j'ai bien compris, explications avec une petite vidéo
Pièce jointe 570926

Le fichier
Pièce jointe 570927

Le code dans le module du formulaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
Dim Mois As String
Dim Col As Long
Dim DatePose As Date, DateTheor As Date, DateFin As Date
 
Private Sub CommandButton1_Click() ' Bouton Valider
    Application.ScreenUpdating = False
    Nom = frmIDPPSMJ.ComboBox1.Value
    Sheets("MENU").Select
    Range("Tableau1[[#Headers],[NOM et Prénom]]").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
    ActiveCell.Offset(1, 0).Select
    ActiveCell = frmIDPPSMJ.ComboBox1.Value
    ActiveCell.Offset(0, 1) = frmIDPPSMJ.TextBox1.Value
    ActiveCell.Offset(0, 2) = Format(frmIDPPSMJ.TextBox2.Value, "mm/dd/yyyy") 'Date de naissance
    ActiveCell.Offset(0, 3) = Format(frmIDPPSMJ.TextBox3.Value, "mm/dd/yyyy") 'Date pose
    DatePose = DateSerial(Year(frmIDPPSMJ.TextBox3.Value), Month(frmIDPPSMJ.TextBox3.Value), Day(frmIDPPSMJ.TextBox3.Value))
    MoisPose = Format(Month(frmIDPPSMJ.TextBox3.Value), "00")
    If TextBox5.Value <> "" Then
        ActiveCell.Offset(0, 5) = Format(frmIDPPSMJ.TextBox5.Value, "mm/dd/yyyy") 'Date réelle de fin
        DateFin = DateSerial(Year(frmIDPPSMJ.TextBox5.Value), Month(frmIDPPSMJ.TextBox5.Value), Day(frmIDPPSMJ.TextBox5.Value))
        MoisFin = Format(Month(frmIDPPSMJ.TextBox5.Value), "00")
    Else
        If TextBox4.Value <> "" Then
            ActiveCell.Offset(0, 4) = Format(frmIDPPSMJ.TextBox4.Value, "mm/dd/yyyy") 'Date théorique
            DateTheor = DateSerial(Year(frmIDPPSMJ.TextBox4.Value), Month(frmIDPPSMJ.TextBox4.Value), Day(frmIDPPSMJ.TextBox4.Value))
            MoisTheor = Format(Month(frmIDPPSMJ.TextBox4.Value), "00")
        End If
    End If
    Call TriALPHA
    Range("C4").Value = frmIDPPSMJ.ComboBox1.Value
    Unload frmIDPPSMJ
 
    'Recopie dans Feuille jaune "Pose"
    Feuille = "Pose " & MoisPose
    With Sheets(Feuille)
        .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
        Set d = .Columns(3).Find(DatePose)
        Col = 4
        Do
            If .Cells(d.Row, Col) <> "" Then Col = Col + 1
        Loop While .Cells(d.Row, Col) <> ""
        .Cells(d.Row, Col) = Nom
    End With
    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
    'Recopie dans Feuille bleue "Fin"
    If DateFin = 0 Then 'S'il n'y a pas la date de fin
        Feuille = "Fin " & MoisTheor
        With Sheets(Feuille) 'alors on cherche la date théorique
            .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            Set d = .Columns(3).Find(DateTheor)
            Col = 4
            Do
                If .Cells(d.Row, Col) <> "" Then Col = Col + 1
            Loop While .Cells(d.Row, Col) <> ""
            .Cells(d.Row, Col) = Nom
        End With
        Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
    Else 'Sinon on supprime la date théorique
        'Feuille = "Fin " & MoisTheor
        'With Sheets(Feuille) 'alors on cherche la date théorique
            '.Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            'Set d = .Columns(3).Find(DateTheor)
            'Col = 4
            'Do
                'If .Cells(d.Row, Col) <> Nom Then Col = Col + 1
            'Loop While .Cells(d.Row, Col) <> ""
            '.Cells(d.Row, Col).ClearContents
        'End With
        'Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
        Feuille = "Fin " & MoisFin
        With Sheets(Feuille) 'on cherche la date de fin
            .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            Set d = .Columns(3).Find(DateFin)
            Col = 4
            Do
                If .Cells(d.Row, Col) <> "" Then Col = Col + 1
            Loop While .Cells(d.Row, Col) <> ""
            .Cells(d.Row, Col) = Nom
        End With
        Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
    End If
    Set d = Nothing
End Sub
 
Private Sub CommandButton2_Click() ' Bouton  Annuler
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton3_Click() 'Bouton Modifier
    'on efface le nom dans les feuilles "Pose" et "fin"
    If ComboBox1.Text <> "" Then
        Nom = ComboBox1.Text
        With Sheets("MENU")
        Set n1 = .Columns(3).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
            If Not n1 Is Nothing Then
                TextBox3.Text = .Cells(n1.Row, "F")
                TextBox4.Text = .Cells(n1.Row, "G")
                If .Cells(n1.Row, "H") <> "" Then TextBox5.Text = .Cells(n1.Row, "H")
            End If
 
            '****************************************************************************************************************
            DatePose = TextBox3.Text
            MoisPose = Format(Month(frmIDPPSMJ.TextBox3.Value), "00")
            Feuille = "Pose " & MoisPose
            With Sheets(Feuille)
                .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                Set d = .Columns(3).Find(DatePose)
                If Not d Is Nothing Then
                    Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                    If Not n2 Is Nothing Then
                        .Cells(d.Row, n2.Column).ClearContents
                    End If
                End If
                Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
            End With
 
            '****************************************************************************************************************
            If TextBox4.Text <> "" Then
                DateTheor = TextBox4.Text
                MoisTheor = Format(Month(frmIDPPSMJ.TextBox4.Value), "00")
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                    Set d = .Columns(3).Find(DateTheor)
                    If Not d Is Nothing Then
                        Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                        If Not n2 Is Nothing Then
                            .Cells(d.Row, n2.Column).ClearContents
                        End If
                    End If
                    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
                End With
            End If
 
            '****************************************************************************************************************
            If TextBox5.Text <> "" Then
                DateFin = TextBox5.Text
                MoisTheor = Format(Month(frmIDPPSMJ.TextBox5.Value), "00")
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                    Set d = .Columns(3).Find(DateFin)
                    If Not d Is Nothing Then
                        Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                        If Not n2 Is Nothing Then
                            .Cells(d.Row, n2.Column).ClearContents
                        End If
                    End If
                    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
                End With
            End If
        End With
    End If
    Sheets("Menu").Rows(n1.Row).Delete 'on efface la ligne dans la feuille "MENU"
    Set n1 = Nothing
    Set n2 = Nothing
    Set d = Nothing
End Sub

cdlt

**roby68** · 07/06/2020, 13h43

Bonjour le Forum, ARTURO83,

OUI, pas de soucis, ci après des captures écran et codes VBA correspondants :
Si cela peut aider sans ouvrir le fichier.

Rappel: si dans les onglets Jaunes et Bleus la première colonne est déjà prise, inscrire le NOM et Prénom dans la deuxième colonne à droite de celle-ci et ainsi de suite.

Code du UserForm ( IDPPSMJ ):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton1_Click() ' Bouton Valider
Application.ScreenUpdating = False
Sheets("MENU").Select
    Range("Tableau1[[#Headers],[NOM et Prénom]]").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
ActiveCell.Offset(1, 0).Select
ActiveCell = frmIDPPSMJ.ComboBox1.Value
ActiveCell.Offset(0, 1) = frmIDPPSMJ.TextBox1.Value
ActiveCell.Offset(0, 2) = Format(frmIDPPSMJ.TextBox2.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 3) = Format(frmIDPPSMJ.TextBox3.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 4) = Format(frmIDPPSMJ.TextBox4.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 5) = Format(frmIDPPSMJ.TextBox5.Value, "mm/dd/yyyy")
Call TriALPHA
'*********************************************************************
' ici - Code NOM et Prénom dans Onglet Jaune et Bleu correspondant aux deux dates :
 
 
 
'*********************************************************************
Range("C4").Value = frmIDPPSMJ.ComboBox1.Value
Application.ScreenUpdating = True
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton2_Click() ' Bouton  Annuler
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton4_Click()
usfCal1.Show
End Sub
 
Private Sub CommandButton5_Click()
usfCal2.Show
End Sub
 
Private Sub CommandButton6_Click()
usfCal3.Show
End Sub

Bien cordialement Roby

**ARTURO83** · 07/06/2020, 14h17

Bonjour,

Avez-vous testé ma proposition jointe?

**roby68** · 07/06/2020, 16h02

rRe le forum, ARTURO83,

Oui, viens juste de tester,
ton code à l'air de bien fonctionner, je verrais sur les postes du bureau demain.
Je trouve le concept de la vidéo correspondante, très cool.

Je te remercie encore pour ta réactivité et la qualité de cette discussion.

Bonne fin de Dimanche à tous

Roby

**roby68** · 07/06/2020, 16h34

Re ARTURO83

Toutefois, à quoi sert le code " Creation_Calendrier_du_mois() " ?

Merci encore

Roby

Dispatching NOM Prénom dans les onglets suivant Dates

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager