Signaler

Simulation roulement

Posez votre question pimous2403 24Messages postés vendredi 3 février 2017Date d'inscription 22 juin 2017 Dernière intervention - Dernière réponse le 6 mars 2017 à 22:39 par pimous2403
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
Afficher la suite 
Utile
+0
plus moins
De l'aide SVP
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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 1673Messages postés lundi 6 mai 2013Date d'inscription 18 juin 2017 Dernière intervention - 7 févr. 2017 à 08:04
Bonjour
Le même avec une petite correction
https://mon-partage.fr/f/s7qoCTVx/
Cdlt
Répondre
pimous2403 24Messages postés vendredi 3 février 2017Date d'inscription 22 juin 2017 Dernière intervention - 7 févr. 2017 à 21:40
Bonjour
Merci pour ton aide.
Je n'ai pas le temps de tester tout de suite. Je te tiens informé de la suite.
Répondre
pimous2403 Frenchie83 - 12 févr. 2017 à 15:37
Bonjour,

Je te remercie pour votre aide concernant mon fichier excel de simulation de service.
Je reviens vers vous ce jour car je souhaiterais faire évoluer le classeur et le faire interagir avec un autre classeur "SERVICES PERIODE 1 v1".
Illustration : si j'utilise le service A001 sur le "SIMULATEUR ROULEMENT V1" le lundi de la semaine 1, celui-ci se "grise" sur le classeur "SERVICES PERIODE 1 v1" sur la feuille du" lun", si j'utilise le service A002 sur le "SIMULATEUR ROULEMENT V1" le lundi de la semaine 2, celui-ci se "grise" sur le classeur "SERVICES PERIODE 1 v1" sur la feuille du" lun (2)", etc...

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

Merci pour ton aide

Cordialement,
Répondre
pimous2403 24Messages postés vendredi 3 février 2017Date d'inscription 22 juin 2017 Dernière intervention Frenchie83 - 12 févr. 2017 à 15:41
Bonjour,

Je te remercie pour votre aide concernant mon fichier excel de simulation de service.
Je reviens vers vous ce jour car je souhaiterais faire évoluer le classeur et le faire interagir avec un autre classeur "SERVICES PERIODE 1 v1".
Illustration : si j'utilise le service A001 sur le "SIMULATEUR ROULEMENT V1" le lundi de la semaine 1, celui-ci se "grise" sur le classeur "SERVICES PERIODE 1 v1" sur la feuille du" lun", si j'utilise le service A002 sur le "SIMULATEUR ROULEMENT V1" le lundi de la semaine 2, celui-ci se "grise" sur le classeur "SERVICES PERIODE 1 v1" sur la feuille du" lun (2)", etc...

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

Merci pour ton aide

Cordialement,
Répondre
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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/


Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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.
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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 24Messages postés vendredi 3 février 2017Date d'inscription 22 juin 2017 Dernière intervention - 16 févr. 2017 à 19:25
Bonjour
Merci pour ton aide.
Je n'ai pas le temps de tester tout de suite. Je te tiens informé de la suite.
Répondre
Donnez votre avis
Utile
+0
plus moins
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/

Donnez votre avis
Utile
+0
plus moins
Bonsoir
Les noms des feuilles "MAR , MER , JEU etc... contiennent un espace à la fin, Supprimez cet espace.
Cdlt
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !