Simulation roulement

Bonsoir
Merci pour ton aide.
Je n'ai pas le temps de tester tout de suite. Je te tiens informé de la suite.
Crdlt

Bonsoir
Je te remercie pour ta réponse. J'ai effectué des essais et j'ai remarqué un problème au niveau de grisage des cellules pour quelque services, si je choisi le A003 les services grisés sont A003,A004 et A006, la meme chose pour plusieurs services sur tout les jours semaines.




J'ai essayé de réparer l'erreur mais sans succès.
"Set c = Columns("A").Find(ServiceEX, LookIn:=xlValues)
NbLig = Selection.Rows.Count
c.Select
If c <> "" Then Range(Cells(c.Row, "A"), Cells(c.Row + NbLig - 1, "S")).Interior.ColorIndex = xlNone"

Merci pour ton aide.

Bonjour
Les modifs + ajout d'un bouton sur chaque feuille "conducteur" pour effacer les tableaux
https://www.cjoint.com/c/GCbhkzeJOfr
Cdlt

Bonjour

Autant pour moi pour mardi. mais ca fait la même chose avec dim(2) conducteur 54040 pourtant le service existe!!
Merci beaucoup pour ton aide.

Bonjour

Merci pour ta réponse.
J'ai effectué des essais, toujours un problème au niveau des saisies.


Merci

Cordialement.

Bonjour
Avec les nouvelles modifications
https://www.cjoint.com/c/GBBhS6rBnFr
Bonne journée
Cdlt

Bonsoir

J'ai effectué les modifications que tu as apportées. J'ai remarqué que quand je choisis le service A001 pour le chauffeur A le lundi de la 1ère semaine, ce même se grise mais si je le corrige et le remplace il ne se dégrise pas. De plus les service choisies pour les autres jours (mardi, mercredi....) ne se grise pas a l'heure choix dans les feuilles spécifique mais sur celle de lundi.

J'espère que mon explication est suffisamment claire.

voici le fichier avec la création des feuilles conducteurs et les modifications que tu m'as demandé de faire : https://mon-partage.fr/f/fFQnQEmt/

Merci pour ton aide.

Bonjour
1)-Important: En premier lieu, il faut réinitialiser les services pour partir d'un fichier vierge. Cliquez sur le bouton "réinitialiser" de la feuille "Services".
2)-Vous n'avez pas affecté les bonnes validations de données pour chaque jour. Pour le lundi de la première semaine, il faut affecter la liste: =Liste_A1_lun_sem1, pour le lundi de la 2ème semaine, se sera: =Liste_A1_lun_sem2, ainsi de suite pour tous les autres jours et pour chaque conducteurs.
3)-remplacez la macro "Grisage" par :

Sub Grisage()
    Application.ScreenUpdating = False
    FeuilleActive = ActiveSheet.Name
    Windows("SERVICES PERIODE 1 v1.xlsm").Activate
    If Sem <> 1 Then Onglet = Left(Jour, 3) & " (" & Sem & ")" Else: Onglet = Left(Jour, 3)
    Set C = Columns("A").Find(Service, LookIn:=xlValues)
    If C Is Nothing Then
        MsgBox "Service introuvable dans le classeur ""SERVICES PERIODE"""
        Exit Sub
    End If
    C.Select
    NbLig = Selection.Rows.Count
    With Range(Cells(C.Row, "A"), Cells(C.Row + NbLig - 1, "S")).Interior
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
    End With
    Windows("SIMULATEUR ROULEMENT V1.xlsm").Activate
    Sheets(FeuilleActive).Select
End Sub

Commencez par ces modifications, on verra par la suite.
Bonne soirée
Cdlt

Bonjour,

J'ai effectué les modifications que tu as apportées. J'ai remarqué que quand je choisis le service A001 pour le chauffeur A le lundi de la 1ère semaine, ce même service reste apparent dans la liste déroulante du chauffeur B pour le même jour, alors que ce n'était pas le cas avant les dernières modifications.

De plus, concernant la feuille "SERVICES PERIODE V1", le but est que lorsque tous les conducteurs auront choisi leur service dans le classeur "simulation de service", tous les services soient grisés. C'est-à-dire qu'au fur et à mesure que les conducteurs choisissent leur service, cela agrémente le classeur "SERVICES PERIODE V1". Exemple, le conducteur A choisis tous ses services pour les 8 semaines, ceux-ci sont donc grisées sur toutes les feuilles du classeur. Le conducteur B verra que ces services sont grisés mais ne pourra pas les sélectionner. Il devra en choisir des non grisés et ainsi de suite pour les autres chauffeurs jusqu'à l'attribution de tous les services à chacun des chauffeurs.

J'espère que mon explication est suffisamment claire.

voici le fichier avec la création des feuilles conducteurs et les modifications que tu m'as demandé de faire : https://mon-partage.fr/f/05macXpA/


Merci beaucoup pour ton aide.

Bonjour
Il va falloir faire quelques modifications.
A faire pour chaque conducteurs, remplacez les macros des modules de feuille par

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D10:J17")) Is Nothing Then
        Jour = Cells(9, Target.Column)
        Sem = Cells(Target.Row, "C")
        Service = Target
        ServiceEx = [A1]
        RetirerService
        'grisage dans le classeur "Services périodes"
        Grisage
        [A1] = Target
        [A1].Select
    End If
End Sub

Commentaires: A chaque sélection d'un service, on le sauvegarde dans la cellule A1 de chaque conducteur, Si pour le même conducteur on change de service, on restitue le précédent service sauvegardé et on supprime le nouveau service sélectionné qui à son tour va s'écrire en A1.

Ensuite, remplacez la macro "RetirerService" par

Sub RetirerService()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    FeuilActive = ActiveSheet.Name
    Liste = Jour & " sem " & Sem
    Sheets("Services").Select
    Set l = Rows("1").Find(Liste, LookIn:=xlValues)
    If l Is Nothing Then Exit Sub
    l.Select
    
    Set ListServ = Range(Cells(l.Row, l.Column), Cells(50, l.Column))
    If ServiceEx <> "" Then
        Set C = ListServ.Find(ServiceEx, LookIn:=xlValues)
        If C Is Nothing Then Cells(49 + 1, l.Column) = ServiceEx
    End If
    
    Set C = ListServ.Find(Service, LookIn:=xlValues)
    C.ClearContents
    Range(Cells(1, l.Column), Cells(50, l.Column)).Select
    ActiveWorkbook.Worksheets("Services").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Services").Sort.SortFields.Add Key:=Range(Cells(2, l.Column), Cells(50, l.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Services").Sort
        .SetRange Range(Cells(1, l.Column), Cells(50, l.Column))
        .Header = xlYes
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets(FeuilActive).Select
    Application.Calculation = xlCalculationAutomatic
End Sub

Avec cette modif, ça devrait aller
Cdlt

Bonjour,

La première manipulation (grisage ou dégrisage d’un service si sélectionné sur les fiches) fonctionne parfaitement pour le 1er conducteur. Je souhaite le faire pour 42 conducteurs.
Un problème apparaît: lorsque j’effectue la même manipulation pour sélectionner les services du " conducteur 2" la macro dégrise les services déjà grisé pour le "conducteur 1" pour les remplacer par ceux du "conducteur 2" .

Je souhaite donc pouvoir griser les services au fur et à mesure, ce qui empêcherait les conducteurs suivant de choisir le même service le même jour deux fois. Ils doivent rester apparents, mais grisés .

merci pour ton aide

Bonjour
Remplacez la macro "RetirerService" par celle-ci

Sub RetirerService()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    FeuilActive = ActiveSheet.Name
    Liste = Jour & " sem " & Sem
    Sheets("Services").Select
    Set l = Rows("1").Find(Liste, LookIn:=xlValues)
    If l Is Nothing Then Exit Sub
    l.Select
    Range("A2:A49").Copy
    Range(Cells(l.Row + 1, l.Column), Cells(49, l.Column)).Select
    ActiveSheet.Paste
    Set ListServ = Range(Cells(l.Row, l.Column), Cells(50, l.Column))
    Set C = ListServ.Find(Service, LookIn:=xlValues)
    If C Is Nothing Then Exit Sub
    C.ClearContents
    Range(Cells(1, l.Column), Cells(50, l.Column)).Select
    ActiveWorkbook.Worksheets("Services").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Services").Sort.SortFields.Add Key:=Range(Cells(2, l.Column), Cells(50, l.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Services").Sort
        .SetRange Range(Cells(1, l.Column), Cells(50, l.Column))
        .Header = xlYes
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets(FeuilActive).Select
    Application.Calculation = xlCalculationAutomatic
End Sub

Cdlt

Rebonjour,

J'ai testé la macro. Elle fonctionne très bien pour griser et dégriser. Cependant, si je choisis par exemple le service A001 dans une cellule et que je le corrige par la suite, il est dégrisé dans le classeur SERVICE PERIODE 1, mais je ne peux pas le ressaisir car il est déjà supprimé de la sélection de la feuille Services dans le classeur SIMULATEUR ROULEMENT V1. Pour le sélectionner à nouveau, il faut réinitialiser, retour à la case départ. Y aurait-il une macro pour pallier à cela ?
merci

Bonjour
Remplacez la macro "Grisage" par celle-ci

Sub Grisage()
    Application.ScreenUpdating = False
    FeuilleActive = ActiveSheet.Name
    Windows("SERVICES PERIODE 1 v1.xlsm").Activate
    If Sem <> 1 Then Onglet = Left(Jour, 3) & " (" & Sem & ")" Else: Onglet = Left(Jour, 3)
    Sheets(Onglet).Select
    With Range("A2:S91").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Set C = Columns("A").Find(Service, LookIn:=xlValues)
    If C Is Nothing Then
        MsgBox "Service introuvable dans le classeur ""SERVICES PERIODE"""
        Exit Sub
    End If
    C.Select
    NbLig = Selection.Rows.Count
    With Range(Cells(C.Row, "A"), Cells(C.Row + NbLig - 1, "S")).Interior
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
    End With
    Windows("SIMULATEUR ROULEMENT V1.xlsm").Activate
    Sheets(FeuilleActive).Select
End Sub

Cdlt

Bonjour,

merci pour ta réponse rapide. J'ai créé les autres feuilles de conducteurs. Tout fonctionne pour l'instant. Le seul bémol est que quand je choisis un service dans une cellule, celui-ci se grise, mais une fois grisé, on ne peut pas revenir en arrière (reste grisé, même quand on rectifie le choix dans la même cellule). c'est-à-dire que l'on est obligé de tout réinitialiser en cas d'erreur de saisie. Y a-t-il une solution pour pallier à cela ?

Merci

Bonsoir
Les noms des feuilles "MAR , MER , JEU etc... contiennent un espace à la fin, Supprimez cet espace.
Cdlt

Bonjour,

Après test et ajout des onglets de conducteurs, je me suis aperçu d'une erreur de la 1ère ligne (semaine 1 a partir de mardi...) : il me sort une erreur (cf capture écran). Je ne parviens pas à la corriger. Je vous renvoie le fichier.
Merci pour votre intérêt.
J'aurais besoin d'une réponse rapide.
Merci

https://mon-partage.fr/f/crmw3gAy/

Bonjour
Question1: je voudrais créer 36 feuilles conducteur par nom et prénom dans le fichier simulation : est-ce qu'il faut copier la macro existante dans la feuille conducteur 1 ? Et comment ?
Il ne faut recopier que la macro qui se trouve dans le module de la feuille "Roulement conducteur ", c'est la même pour tous les conducteurs. il faut la recopier dans chaque nouvelle feuille conducteur créée.


Dans le module "this Workbook",
la deuxième ligne doit être:

Workbooks.Open Filename:="C:\Users\jenetniz\Desktop\Pimous\SERVICES PERIODE 1 v1.xlsm"

c'est le fichier "SERVICES PERIODES" que l'on doit ouvrir.

2ème Question:est-ce qu'il faut changer des paramètres pour que la ou les macro reconnaissent les nouvelles feuilles créer ? Où ? NON

3ème Question: si je souhaite ajouter des services dans la feuille "services" dans le classeur simulation, comment déclarer les cellules ajoutées ? En déclarant les nouvelles listes dans la feuille "Services", en dessous de liste déjà crée. Dans la macro "RetirerService", remplacer la valeur 50 par le numéro de la dernière ligne. Pensez à modifier les plages ou en créer d'autres.

Bon courage
Cdlt

Bonjour,

Merci pour les corrections apportées. J'ai encore juste quelques questions :

- je voudrais créer 36 feuilles conducteur par nom et prénom dans le fichier simulation : est-ce qu'il faut copier la macro existante dans la feuille conducteur 1 ? Et comment ?


- est-ce qu'il faut changer des paramètres pour que la ou les macro reconnaissent les nouvelles feuilles créer ? Où ?



- si je souhaite ajouter des services dans la feuille "services" dans le classeur simulation, comment déclarer les cellules ajoutées ?


Merci encore

C'est toujours lié aux problèmes des noms de feuille.
remplacez la macro Degrisage par celle-ci

Sub Degrisage()
    Application.ScreenUpdating = False
    Windows("SERVICES PERIODE 1 v1.xlsm").Activate
    Sheets("lun").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets(Array("lun", "lun (2)", "lun (3)", "lun (4)", "lun (5)", "lun (6)", "lun (7)", _
        "lun (8)", "mar ", "mar (2)", "mar (3)", "mar (4)", "mar (5)", "mar (6)", "mar (7)", _
        "mar (8)", "mer ", "mer (2)", "mer (3)", "mer (4)", "mer (5)", "mer (6)", "mer (7)", _
        "mer (8)", "jeu")).Select
    Sheets(Array("jeu (2)", "jeu (3)", "jeu (4)", "jeu (5)", "jeu (6)", "jeu (7)", _
        "jeu (8)", "ven", "ven (2)", "ven (3)", "ven (4)", "ven (5)", "ven (6)", "ven (7)", _
        "ven (8)", "sam", "sam (2)", "sam (3)", "sam (4)", "sam (5)", "sam (6)", "sam (7)", _
        "sam (8)", "dim", "dim (2)")).Select Replace:=False
    Sheets(Array("dim (3)", "dim (4)", "dim (5)", "dim (6)", "dim (7)", "dim (8)")).Select Replace:=False
    Range("A2:S200").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets(1).Select
    Windows("SIMULATEUR ROULEMENT V1.xlsm").Activate
End Sub

cdlt