Simulation roulement

De l'aide SVP

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

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

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

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

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

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/

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

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.

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

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

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,

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/

Bonsoir
Les noms des feuilles "MAR , MER , JEU etc... contiennent un espace à la fin, Supprimez cet espace.
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

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

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 "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

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
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