SPASME = Suivi de Personnel Activité Super siMplE

Forum pour partager vos applications Excel avec les autres membres ...
Avatar du membre
LouReeD
Passionné d'Excel
Passionné d'Excel
Messages : 3371
Appréciations reçues : 26
Inscrit le : 14 octobre 2014
Version d'Excel : 2007 FR
Téléchargements : Mes applications

Message par LouReeD » 8 février 2018, 16:39

Bonjour,

merci de vos remerciements ! :)

Pour ce qui est de votre question, normalement c'est ce qui est prévu, non ?
Et non... ce n'est prévu que pour les weekend, là où la couleur de l'activité ne se met pas... ::(
Il faut donc modifier le code VBA de la SUB suivante qui se trouve sur la feuille Planning :

Code : Tout sélectionner

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Modifié = True
    Call Vérification_Code_Activité_Valeur
    Dim Trouve As Range, PlageDeRecherche As Range
    Dim Valeur_Cherchee As String, AdresseTrouvee As String
    Dim MaPlage As Range, La_Selection_A_Tester As Range
    Set MaPlage = ThisWorkbook.Sheets(1).ListObjects("Planning").Range
    Set La_Selection_A_Tester = Selection
    If SelectionDansPlage(La_Selection_A_Tester, MaPlage) = True Then
        If Target.Rows.Count = 1 And Target.Row > [Repère].Row + 1 And Target.Column > [Repère].Column Then
            If En_cours = True Then
                Dim C As Range
                If Le_Texte <> "" Then
                    For Each C In Selection
                        With C
                            If Week_End = False Then
                                If Sheets(1).Cells(1, C.Column).Value = 1 Then
                                    .Interior.Color = La_Couleur.Interior.Color
                                    .ClearComments
                                    .Value = Le_Texte
                                Else
                                    .Interior.Color = xlNone
                                    .Value = ""
                                    .ClearComments
                                End If
                            Else
                                .Interior.Color = La_Couleur.Interior.Color
                                'If Sheets(1).Cells(1, C.Column).Value <> 1 Then
                                    .Value = Le_Texte
                                'End If
                                .ClearComments
                            End If
                        End With
                    Next
                Else
                    Selection.Interior.Color = xlNone
                    Selection.Value = ""
                    Selection.ClearComments
                End If
            End If
            'ActiveCell.Select
            Cells(Target.Row, Target.Column).Select
            Modifié = True
        End If
    ElseIf Not Intersect(Target, Range("Activitées")) Is Nothing Then
        With [Positions]
            .Interior.Color = xlNone
            .Font.Bold = False
            .Font.Color = RGB(0, 0, 0)
            .Font.Size = 9
            .HorizontalAlignment = xlLeft
        End With
        With Cells(Target.Row, 1)
            .Interior.Color = [couleur_positions].Interior.Color
            .Font.Bold = True
            .Font.Color = [couleur_positions].Font.Color
            .Font.Size = 11
            .HorizontalAlignment = xlRight
            Le_Texte = .Offset(0, 1).Value
            Set La_Couleur = Cells(Target.Row, 2)
            Set PlageDeRecherche = [Codes_WE]
            Set Trouve = PlageDeRecherche.Cells.Find(what:=Le_Texte, lookat:=xlWhole)
            If Trouve Is Nothing Then
                Week_End = False
            Else
                Week_End = True
            End If
        End With
        En_cours = True
    Else
        En_cours = False
        With [Positions]
            .Interior.Color = xlNone
            .Font.Bold = False
            .Font.Color = RGB(0, 0, 0)
            .Font.Size = 9
            .HorizontalAlignment = xlLeft
        End With
        Le_Texte = ""
    End If
End Sub
Pour y accéder, clic droit sur le nom de l'onglet de la feuille "Planning", puis "afficher code", trouver et remplacez le code de la
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
et remplacez le par celui ci dessus.
Dorénavant les codes s'affichent sur les jours ouvrés et chômés.

@ bientôt

LouReeD
Coin, coin ! :playa:
Je jette des pavés dans la marre... 14 au choix, avec un panel d'utilisation énorme ! :lol:
(voir "Mes applications" ;;) )
revemane
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 8 février 2018
Version d'Excel : 2016

Message par revemane » 8 février 2018, 16:41

un grand merci pour cette modification
Avatar du membre
LouReeD
Passionné d'Excel
Passionné d'Excel
Messages : 3371
Appréciations reçues : 26
Inscrit le : 14 octobre 2014
Version d'Excel : 2007 FR
Téléchargements : Mes applications

Message par LouReeD » 8 février 2018, 16:45

Pas de quoi, j'essaie d'être rapide et efficace... ;;)

Je n'y arrive pas toujours :lol: Mais bon je m'en sort ! :)

@ bientôt et bonne utilisation,

LouReeD
Coin, coin ! :playa:
Je jette des pavés dans la marre... 14 au choix, avec un panel d'utilisation énorme ! :lol:
(voir "Mes applications" ;;) )
revemane
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 8 février 2018
Version d'Excel : 2016

Message par revemane » 9 février 2018, 13:25

merci celà fonctionne à merveille

je me demandais aussi mais çà dépasse mes compétences,
si ce serait possible que lorsque l'on à attribué un code à une cellule du planning qu'il ne soit plus possible de la modifier ( par exemple , changer de code , ou via le code effacement) et que si on veut modifier une cellule, une popup avec mot de passe apparaisse et ce afin de laiser libre choix à chaque utilisateur de marquer son pointage me que seulement une personne connaissant le mot de passe puisse faire les modifications

merci d'avance
Avatar du membre
LouReeD
Passionné d'Excel
Passionné d'Excel
Messages : 3371
Appréciations reçues : 26
Inscrit le : 14 octobre 2014
Version d'Excel : 2007 FR
Téléchargements : Mes applications

Message par LouReeD » 11 février 2018, 21:09

Bonsoir,

là, pour moi, cela devient compliqué... Une autorisation de modification pour chaque personnel...
Désolé. :oops:

@ bientôt

LouReeD
Coin, coin ! :playa:
Je jette des pavés dans la marre... 14 au choix, avec un panel d'utilisation énorme ! :lol:
(voir "Mes applications" ;;) )
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message