simulation roulement Résolu

Question

Bonjour, 
Bonjour, 
Dans le cadre de mon travail, afin de faciliter la gestion des plannings, je sollicite votre aide sur un point : Dans un classeur Excel avec plusieurs feuilles (cf pièce jointe), j'aimerais créer plusieurs feuilles symbolisant des semaines type conducteurs qui puiseront leurs données dans la feuille "ValeurhoraireR". Le but étant que la feuille "Roulement conducteur 1", je choississe par exemple le service "A01" pour le lundi 1ère semaine et que donc ce service se masque ou ne soit plus sélectionnable dans la "feuille Roulement conducteur 2 " et ainsi de suite... Ceci afin de créer des roulements conductuer unique avec 36 services par jour et 12 conducteurs en repos, c'est-à-dire au total 48 affectations par jour et donc un roulement sur 48 tour.
https://mon-partage.fr/f/BXbcflYy/
Merci pour votre aide

pimous2403 · Answer

De l'aide SVP

Frenchie83 · Answer

Bonjour
Voici une proposition partielle, à vous de continuer si cela vous convient
https://mon-partage.fr/f/Jngw5Zuw/
J'ai créer uns feuille "Services" ou se trouve tous les services "A" pour chaque jour et sur 8 semaines.
la première colonne contient le liste complète, les autres se réduisent au fur et à mesure que l'on sélectionne une valeur dans la fiche d'un conducteur.
Il faut réaffecter pour chaque conducteur les validations de données. pour le conducteur1, la validation de données fait référence à la liste de la colonne A de "Services" (liste complète), pour tous les autres il faut leur affecter la validation de données des autres colonnes (en fonction du jour et du numéro de la semaine), pour les 3 conducteurs je n'ai appliquer les validations uniquement sur les 8 semaines que du lundi et mardi, à vous de faire le reste.
Pour chaque feuille de conducteur que vous ajouterez, il faudra recopier la macro qui se trouve dans le module de la feuille 1.
Pour réinitialiser les listes, allez dans la feuille "services" et cliquez sur le bouton "réinitialiser".
En espérant avoir été suffisamment clair. Il reste encore beaucoup de travail. Bon courage.
Cdlt

pimous2403 · Answer

Bonjour, 
Je vous remercie de votre intérêt et de la rapidité de votre réponse. Vos informations me paraissent claires. Je me permettrai toutefois de vous recontacter en cas de souci. 
Merci

Frenchie83 · Answer

Bonjour
https://mon-partage.fr/f/BhOqjtYQ/
A l'ouverture du fichier "SIMULATEUR ROULEMENT", j'ai mis un stop dans le programme d'ouverture pour que vous mettiez le chemin réel de votre dossier à la place de    
 Workbooks.Open Filename:="C:\Emplacement du dossier\SERVICES PERIODE 1 v1.xlsm"
Les 2 lignes consécutives
    Sheets("Roulement conducteur 2").Select
    Sheets("Roulement conducteur 1").Select
 ne sont pas une erreur de ma part mais bien une action volontaire pour contourner un problème d'affichage.
Supprimez le stop et relancez.
Le fichier "SERVICES PERIODE" s'ouvre dans une autre fenêtre.
Lors de la sélection d'un service dans le fichier "SIMULATEUR ROULEMENT", celui-ci est grisé dans la feuille correspondante du fichier "SERVICES PERIODE".
L'action sur le bouton "Réinitialiser" de la feuille "Services" à pour effet de supprimer toutes les cellules grisées du fichier "SERVICES PERIODE".
 En espérant avoir répondu à votre problème.
Cdlt

pimous2403 · Answer

Bonjour,
Je vous remercie vivement de l'intérêt que vous portez à ma demande. 
Après utilisation, seuls quelques petits dysfonctionnements apparaissent. Je vous joins des captures d'écran à ce sujet.
Merci pour votre aide,
Cordialement

Frenchie83 · Answer

Bonjour Le problème vient du nom de chaque feuille. il y a 2 espaces entre le nom du jour et le numéro entre parenthèses. remplacez la ligne suivante If Sem <> 1 Then Onglet = Left(Jour, 3) & " (" & Sem & ")" Else: Onglet = Left(Jour, 3) par If Sem <> 1 Then Onglet = Left(Jour, 3) & " (" & Sem & ")" Else: Onglet = Left(Jour, 3) De plus, modifiez les feuilles du mercredi supprimer le "c" de "merc" (le nom des jours ne doit contenir que 3 caractères) Voilà Cdlt

pimous2403 · Answer

Bonsoir, 
Après avoir testé ce que vous m'avez envoyé tout à l'heure, j'ai toujours un problème (cf image) : par exemple, quand je choisis le lundi de la semaine 2 et que je sélectionne un service, le résultat est qu'il me renvoie vers le classeur "SERVICES PERIODE 1 v1" et m'affiche un message d'erreur. 
Est-il possible de m'aider à résoudre ce problème ? Je suis novice en VBA
https://mon-partage.fr/f/qqPI7jJq/

Frenchie83 · Answer

Bonjour
https://mon-partage.fr/f/jLIbGzP6/
Dans le classeur "SERVICES PERIODES", les noms des feuilles sont écrits avec 1 ou 2 espaces. J'ai renommé toutes les feuilles avec un seul espace et supprimé cet espace supplémentaire dans la ligne de code.
Cdlt

pimous2403 · Answer

Bonjour,
Tout d'abord, un grand merci pour l'intérêt que vous portez à mes demandes. 
Cependant, malgré les corrections apportées, quand je veux dégriser les lignes et réinitialiser le classeur "SERVICES PERIODES" par le bouton "réinitialiser", une erreur de débogage apparaît.
Vous remerciant de pouvoir m'apporter votre aide.

Frenchie83 · Answer

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

pimous2403 · Answer

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

Frenchie83 · Answer

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

pimous2403 · Answer

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/

Frenchie83 · Answer

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

pimous2403 · Answer

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

Frenchie83 · Answer

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

pimous2403 · Answer

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

Frenchie83 · Answer

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

pimous2403 · Answer

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

Frenchie83 · Answer

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

pimous2403 · Answer

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.

Frenchie83 · Answer

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

pimous2403 · Answer

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.

Frenchie83 · Answer

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

pimous2403 · Answer

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

pimous2403 · Answer

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.

Frenchie83 · Answer

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

pimous2403 · Answer

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.

pimous2403 · Answer

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

Simulation roulement - Page 2

Discussions similaires

Newsletters