Discussion :

[Yassine51100]

Bonjour à tous,

Je débute sur Excel et je souhaiterais réaliser un planning hebdomadaire pour 10 chauffeurs sur une seul page excel qui change en fonction des chauffeurs ainsi que des semaines (voir fichier joint).

J'ai déjà réalisé la forme mais je ne sais pas le rendre automatique, ce que j'aimerai c'est par exemple cliquer sur la cellule C8 et qu'apparaisse un UserForm dans lequel je devrais préciser l'heure de début et l'heure de fin et l'adresse puis que ça se mettent automatiquement dans la cellule (voir fichier joint dans lequel je l'ai fait manuellement).

Je sais qu'il faut que je fasse un VBA mais je n'en ai aucune idée de comment cela fonctionne, je regarde énormément de tutos mais rien n'y fait j'y arrive pas.

Si vous pouvez me donner des explications, un accompagnement, ce ne serai pas de refus.

Vous trouverez ci-joint le fichier commencé.

En vous remerciant,

[ARTURO83]

Bonjour,

Voici, faites un double-clic sur la cellule de votre choix pour faire apparaître le formulaire
Pièce jointe 525976

Cdlt

[Yassine51100]

Bonjour,

Voici, faites un double-clic sur la cellule de votre choix pour faire apparaître le formulaire
Pièce jointe 525976

Cdlt

Bonjour ARTURO83,

Merci énormément pour le fichier envoyé, c'est exactement ce que je cherchais à faire.

Le seul bémol maintenant, c'est que lorsque je change de chauffeurs ou de semaines, les cellules restes. Moi j'aimerai que lorsque je change par exemple de chauffeurs, un nouveau planning vide apparaît et hop je le complète.

En tout cas, merci encore pour ce que vous m'avez envoyé.

Bien cordialement,

[ARTURO83]

Moi j'aimerai que lorsque je change par exemple de chauffeurs, un nouveau planning vide apparaît

il suffit d'ajouter ce bout de code dans le module de la feuille "Planning"

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Address = "$F$5" Then
        Range("C8:I20").ClearContents
    End If
    Application.EnableEvents = True
End Sub

le fichier modifié
Pièce jointe 525998

Cdlt

[Yassine51100]

Bonjour,

Merci beaucoup ça fonctionne très bien !

Si je veux également que sa change en fonction des semaines est-ce qu'il faut que je rajoute au code "$F$5" and "$I$5" ?
Et est-ce qu'il faudrait pas rajouter une fonction enregistrer pour que lorsque je souhaite revoir un planning d'un chauffeur auquel j'ai ajouté des cellules, ces dernières reste car quand je change de chauffeurs les cellules disparaissent ce qui est parfait mais lorsque je repart vers le chauffeur précédent les cellule ajoutées disparaissent...

Bien cordialement,

[ARTURO83]

Si je veux également que sa change en fonction des semaines est-ce qu'il faut que je rajoute au code "$F$5" and "$I$5" ?

OUI

Et est-ce qu'il faudrait pas rajouter une fonction enregistrer pour que lorsque je souhaite revoir un planning d'un chauffeur auquel j'ai ajouté des cellules, ces dernières reste car quand je change de chauffeurs les cellules disparaissent ce qui est parfait mais lorsque je repart vers le chauffeur précédent les cellule ajoutées disparaissent...

Evidemment , il faut créer une zone de stockage (une feuille dédiée à cela) de toutes les informations saisies, si le chauffeur recherché est déjà enregistré, il suffit de remonter les informations. mais pour cela il faut commenciez par créer cette feuille pour la zone de stockage.
A vous de voir comment vous aller la construire pour pouvoir d'une part y stocker les informations saisies dans la feuille "Planning" et ensuite pour les récupérer si elles existent.

[tototiti2008]

Bonjour,

Je m'y étais mis alors je poste ma proposition

[ARTURO83]

Bonjour,

Voici le fichier
Pièce jointe 526214

Les codes utilisés
Module ThisWorkbook

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Application.ScreenUpdating = False
    Set f1 = Sheets("Planning")
    Set f2 = Sheets("Enregistrements")
 
    f1.Select
    Range("N7").FormulaArray = "=IF(ISNA(MATCH(R5C6&"" ""&R5C9,Enregistrements!C6&"" ""&Enregistrements!C5,0)),""NON"",IF(MATCH(R5C6&"" ""&R5C9,Enregistrements!C6&"" ""&Enregistrements!C5,0>0),""OUI"",""NON""))"
    Charger_Planning
End Sub

Module Planning

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C8:I12")) Is Nothing Then Planning.Show
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Address = "$F$5" Or Target.Address = "$I$5" Then
        Enregistrement
        Range("C8:I20").ClearContents
        If [N7] = "OUI" Then
            Charger_Planning
        End If
    End If
    Application.EnableEvents = True
End Sub

Module Enregistrements

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.EnableEvents = False
    If Target.Column = 6 And Target.Value <> "" Then
        Lig_Cible = Target.Row
        Charger_Planning
    End If
    Application.EnableEvents = True
End Sub

Module Userform

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
Private Sub UserForm_Initialize()
    Set D1 = CreateObject("Scripting.Dictionary")
    For Each c In Sheets("Listes").Range("G2:G25")
        D1(c.Text) = ""
    Next c
    Heure_Deb.List = Application.Transpose(D1.keys)
    Heure_Fin.List = Application.Transpose(D1.keys)
    Label_Date_Jour = Date
End Sub
 
Private Sub Enregistrer_Click()
    ActiveCell.Value = Heure_Deb & " - " & Heure_Fin & Chr(10) & Adresse & Chr(10) & Code_Postal & " " & UCase(Ville)
    Msg = "Plage horaire incorporée au planning" & Chr(10) & "Après avoir rempli la semaine complète, pensez à cliquer sur le bouton ""Cliquez ici pour enregistrer  ..."" pour l'enregistrer"
    CreateObject("Wscript.shell").Popup Msg, 1, "Enregistrement de la semaine"
    Heure_Deb = ""
    Heure_Fin = ""
    Adresse = ""
    Code_Postal = ""
    Ville = ""
    Unload Planning
End Sub
 
Private Sub Annuler_Click()
    Heure_Deb = ""
    Heure_Fin = ""
    Adresse = ""
    Code_Postal = ""
    Ville = ""
End Sub

Module 1 standard

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
Option Compare Text
Dim l As Long, c As Long, N° As Long, DerCol As Long, DerLig_f1 As Long, DerLig_f2 As Long, Lig As Long
Dim Date_Enr As Date
Public Lig_Cible As String
Public f1 As Worksheet, f2 As Worksheet
 
Sub Enregistrement()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Planning")
    Set f2 = Sheets("Enregistrements")
    Chauffeur = f1.[F5]
    Semaine = f1.[I5]
    If f1.[K4] <> 0 Then 's'il y a au mois 1 plage saisie dans le planning
        If f1.[N7] = "NON" Then 'Si le chauffeur n'a pas encore été enregistré
            Enregistrer
            f1.Range("C8:I20").ClearContents 'on efface les données du planning après enregistrement
        ElseIf f1.[N7] = "OUI" Then 'Si le chauffeur a déjà été enregistré, on  laisse le choix d'enregistrer ou non,
            If MsgBox("Attention les données existantes vont être supprimées et remplacées par celles-ci. Etes-vous sûr de vouloir effectuer le remplacement?", vbYesNo + vbCritical + vbDefaultButton2, "Enregistrement du planning") = vbYes Then
                'Si la réponse est "OUI", alors on efface les anciens enregistrements
                f2.Select
                DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
                f2.Range("A1:G1").AutoFilter
                If f2.AutoFilterMode = False Then f2.Range("A1:G1").AutoFilter
                f2.Range("A1:G" & DerLig_f2).AutoFilter Field:=6, Criteria1:=Chauffeur 'filtre sur les crières sélectionnés
                f2.Range("A1:G" & DerLig_f2).AutoFilter Field:=5, Criteria1:=Semaine
                f2.Rows("2:" & DerLig_f2).SpecialCells(xlCellTypeVisible).Select 'Delete
                f2.Rows("2:" & DerLig_f2).SpecialCells(xlCellTypeVisible).Delete
                Enregistrer
                f1.Range("C8:I20").ClearContents 'on efface les données du planning après enregistrement
            End If
        End If
    End If
    If f2.AutoFilterMode = True Then f2.Range("A1:G1").AutoFilter
End Sub
 
Sub Enregistrer()
    DerCol = 8
    DerLig_f1 = f1.Range("C7").SpecialCells(xlCellTypeLastCell).Row
    Date_Enr = Date & " " & Time
    N° = f1.[K2]
    If f2.AutoFilterMode = True Then f2.Range("A1:G1").AutoFilter
    Lig = f2.Range("A" & Rows.Count).End(xlUp).Row + 1
    For c = 3 To DerCol
         For l = 8 To DerLig_f1
            If f1.Cells(l, c) <> "" Then
                f2.Cells(Lig, "A") = N° 'N° d'enregistrement
                f2.Cells(Lig, "B") = Date_Enr 'Date de l'enregistrement
                f2.Cells(Lig, "C") = f1.Cells(l, c).Address 'Adresse de la cellule contenant les données
                f2.Cells(Lig, "D") = f1.[C5] 'Année
                f2.Cells(Lig, "E") = f1.[I5] 'Semaine
                f2.Cells(Lig, "F") = f1.[F5] 'Chauffeur
                f2.Cells(Lig, "G") = f1.Cells(l, c) 'cellule contenant les données
                Lig = Lig + 1
            End If
         Next l
     Next c
End Sub
 
Sub Charger_Planning()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Planning")
    Set f2 = Sheets("Enregistrements")
 
    f1.Range("C8:I20").ClearContents
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    Chauffeur = f1.[F5]
    Semaine = f1.[I5]
 
    'filtre sur les crières sélectionnés
    f2.Select
    f2.Range("A1:G1").AutoFilter
    If f2.AutoFilterMode = False Then f2.Range("A1:G1").AutoFilter
 
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("A1:G" & DerLig_f2).AutoFilter Field:=6, Criteria1:=Chauffeur
    f2.Range("A1:G" & DerLig_f2).AutoFilter Field:=5, Criteria1:=Semaine
 
    'récupération des données dans la zone filtrée
    If DerLig_f2 = 1 Then
        f1.Select
        Exit Sub
    End If
    Set ZoneFiltree = f2.Range(Cells(2, "G"), Cells(DerLig_f2, "G")).SpecialCells(xlVisible)
    For Each cell In ZoneFiltree
        f1.Range(f2.Cells(cell.Row, "C")).Value = cell
    Next
    f1.Select
End Sub
 
Sub Tout_Effacer()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Planning")
    Set f2 = Sheets("Enregistrements")
    If MsgBox("Attention tous les enregistremnts vont être supprimés. Etes-vous sûr de vouloir continuer?", vbYesNo + vbCritical + vbDefaultButton2, "Effacer les enregistrements") = vbYes Then
        f2.Range("A1:G1").AutoFilter
        If f2.AutoFilterMode = False Then f2.Range("A1:G1").AutoFilter
        f2.Range("A2:G10000").ClearContents
        f1.Range("C8:I20").ClearContents
    End If
    If f2.AutoFilterMode = True Then f2.Range("A1:G1").AutoFilter
End Sub
 
Sub Supprimer_un_Enregistrement()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Planning")
    Set f2 = Sheets("Enregistrements")
    N° = f2.Cells(ActiveCell.Row, "A")
    If MsgBox("Attention tous les enregistremnts comportant le N° " & N° & " vont être supprimés. Etes-vous sûr de vouloir continuer?", vbYesNo + vbCritical + vbDefaultButton2, "Effacer un enregistrement") = vbYes Then
        f2.Range("A1:G1").AutoFilter
        If f2.AutoFilterMode = False Then f2.Range("A1:G1").AutoFilter
 
        DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
        f2.Range("A1:G" & DerLig_f2).AutoFilter Field:=1, Criteria1:=N°
        f2.Rows("2:" & DerLig_f2).SpecialCells(xlCellTypeVisible).Delete
    End If
    If f2.AutoFilterMode = True Then f2.Range("A1:G1").AutoFilter
End Sub

Cdlt