XL 2016 Colorer l'intérieur d'une cellule sélectionnée

[ReneDav14000]

Bonjour le forum,
Pourriez-vous me dire où dois-je insérer cette instruction dans le code ci-dessous s'il vous plaît ?
L'instruction est censée colorer en vert la cellule sélectionnée ensuite je dois ajouter une autre instruction pour annuler la couleur lorsqu'une autre cellule est sélectionnée.
Je vous en remercie par avance

Instruction :

Selection.Interior.Color = RGB(0,255,0) 'Vert'

Code où doit-être insérée cette instruction :

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pos As Integer
Dim sem As String
    Application.ScreenUpdating = False
    
    If Target.Row = 5 Or Target.Row = 14 Then 'Ligne des mois
        Range("B24") = Target.Offset(0, -1).Value 'maj mois
        Range("B26").Value = Target.Offset(0, -1).Value 'début mois choisi
    End If
    
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row >= 7 And Target.Row <= 21 Then
        Range("B24") = Target.Value  'maj mois
        
        sem = CStr(Application.IsoWeekNum(Target.Value)) 'semaine
        
        Range("B26").Value = DateSerial(Year(Target.Value), Month(Target.Value), 1)  ' début mois choisi
        
        With Worksheets(sem)  'sélection feuille
            .Visible = True
            .Activate
            pos = 1 'sélection date
            While .Range("A2").Offset(0, pos).Value <> Target.Value
                pos = pos + 1
            Wend
            .Range("A2").Offset(0, pos).Activate 'position colonne
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[ReneDav14000]

Bonsoir le forum,
J'espère que vous avez passé une bonne journée.
Je reviens avec mon projet de calenagenda. Je pense avoir bien avancé grâce aux bons conseils de patricktoulon, p56, GéGé-45550 que je remercie chaleureusement.
Je bloque encore sur quelques détails.
- Lorsque je clique sur "ok" de la feuille Calend, la feuille Agenda s'affiche. La colonne qui correspond à la date choisie n'est pas sélectionnée, je souhaite modifier ça.
- Dans la feuille Data où sont sauvegardées les données de la feuille Agenda, je rencontre un problème. Même si je ne saisis rien dans la feuille Agenda, j'ai systématiquement une information d'entrée (N° Semaine, Date et heure), je dois également modifier ça.
Voilà mes deux pierres d'achoppements sinon le reste à l'air de fonctionner correctement. Après ce sera des détails de "déco".
Encore mille merci à tous pour votre aide

 

[Gégé-45550]

Bonsoir,
Essayez ceci, en PJ.
Cordialement

 

[ReneDav14000]

Bonsoir,
Essayez ceci, en PJ.
Cordialement

Bonsoir Gégé-45550,
C'est super comme ça. Merci beaucoup.
Désolé d'avoir tardé à répondre.
Bonne fin de soirée

 

[patricktoulon]

Bonjour
je constate que finalement on a adopté mon calendrier
qui a certes changé de couleur et de taille mais ça reste le mien avec mes formules

elle est ou là ta hiérarchie qui n'en voulait pas ?

en fin c'est pas grave au moins un qui a compris l'astuce pour retrouver la coloration dynamique sur cellule sélectionnée qui ont plusieurs MFC

si @Gégé-45550 a su déplacer c'est qu'il a compris

j'aurais pas perdu mon temps finalement

 

[ReneDav14000]

Bonjour
je constate que finalement on a adopté mon calendrier
qui a certes changé de couleur et de taille mais ça reste le mien avec mes formules

elle est ou là ta hiérarchie qui n'en voulait pas ?

en fin c'est pas grave au moins un qui a compris l'astuce pour retrouver la coloration dynamique sur cellule sélectionnée qui ont plusieurs MFC

si @Gégé-45550 a su déplacer c'est qu'il a compris

j'aurais pas perdu mon temps finalement

Bonjour patrick, bonjour le forum,

Je reconnais que la gestion est plus facile, mais attendons la réaction de ma hiérarchie à qui je dois présenter le projet ce matin, il y aura peut-être des modifications à apporter.
En l'état moi ça me convient tout à fait. Je te remercie chaleureusement pour tes remarques et pour ton aide ainsi que tous ceux qui m'ont aidé à mener à bien ce projet.
Je reviendrai en fin de matinée vous donner le résultat de la réunion.

 

[ReneDav14000]

Bonjour le forum,
Bon, je sors de réunion et ça n'a pas été facile. Toutefois, le projet d'agenda sur feuille unique est accepté, il y a cependant une modification à apporter sur la feuille Agenda.
Est-ce qu'il est possible de mettre des flèches en E1 afin de passer à la semaine suivante ou revenir à la semaine antérieure ?
J'ai souligné la difficulté de la sauvegarde du fait que l'on ne travaille que sur une seule feuille. Personnellement je ne vois pas comment faire. Je vais chercher et on verra.
Encore mille merci à tous pour la réalisation de ce projet.

 

[p56]

Bonjour,
?? A noter : dans le fichier démo que j'ai fourni (et qui me semble a été utilisé comme base de travail avec celui de P.Toulon), il y a une toupie pour passer d'une semaine à une autre, pourquoi l'avoir ôté? ...
https://excel-downloads.com/threads...-cellule-selectionnee.20072149/#post-20550357

 

[ReneDav14000]

j'aurais pas perdu mon temps finalement

patrick, tu ne perds jamais ton temps même si parfois on a la compréhension difficile. On apprend toujours quelque chose et c'est ça qui me plaît. A chaque fois, pour ma part, c'est un nouveau défi contre les coups du temps qui passe.

 

[ReneDav14000]

Bonjour,
?? A noter : dans le fichier démo que j'ai fourni (et qui me semble a été utilisé comme base de travail avec celui de P.Toulon), il y a une toupie pour passer d'une semaine à une autre, pourquoi l'avoir ôté? ...
https://excel-downloads.com/threads...-cellule-selectionnee.20072149/#post-20550357

Je regrette de l'avoir fait, je ne pensais pas déjà qu'il accepterait le projet alors la toupie... et pourtant il faut y revenir. C'est ma faute. Je vais reprendre ton code et l'ajouter.

 

[p56]

Pas de soucis, mais il me semble qu'il y a aussi des oublis dans les copier/coller.
Voici une version qui me semble propre avec toupie pour changer de semaine et code encore simplifié.
P.

 

[ReneDav14000]

Pas de soucis, mais il me semble qu'il y a aussi des oublis dans les copier/coller.
Voici une version qui me semble propre avec toupie pour changer de semaine et code encore simplifié.
P.

Merci beaucoup p56.
Cependant je rencontre un petit soucis lorsque je change de semaine avec la ligne de code 10 en surbrillance.
Sinon ça me va très bien. Je mettrais un peu de mise en forme avec de la couleur et ce sera très bien.

Sub Complete(Optional b As Byte)
Dim T As Variant, i As Integer
Dim Dt0 As Double, lg As Integer, cl As Integer

    Ecrit = True
    Application.ScreenUpdating = False
    With Sheets("Agenda")
        .Range("C3:AG26").ClearContents
        Dt0 = .Range("C2").Value
        T = Range("T_Bdd").ListObject.DataBodyRange 'Message d'erreur ici
        On Error GoTo suite
        For i = 1 To UBound(T)
            If T(i, 2) >= Dt0 And T(i, 2) < Dt0 + 7 And T(i, 3) >= .Range("B4").Value Then
                lg = 4 + ((T(i, 3) - .Range("B4").Value) * 24 * 2)
                cl = 3 + T(i, 2) - Dt0
                .Cells(lg, cl + 24).Value = T(i, 1)
                .Cells(lg, cl).Value = T(i, 5)
            End If
suite:
        Next i
        On Error GoTo 0
    End With
    Application.ScreenUpdating = True
    Ecrit = False
End Sub

 

[p56]

? Curieux, problème de version peut être?
Dans le doute, une alternative est possible => voir fichier joint

 

[ReneDav14000]

? Curieux, problème de version peut être?
Dans le doute, une alternative est possible => voir fichier joint

Super ça fonctionne. Je ne sais pas ce qui s'est passé.
Mille merci, je vais pouvoir continuer.
Merci également à patricktoulon ainsi qu'à Gégé-45550

 

[ReneDav14000]

Je vais encore vous solliciter car j'ai besoin de récupérer le numéro de semaine dans la feuille BDD.
J'ai regardé le code, je sais que je dois le placer ici dans ce code mais je ne sais pas quoi mettre.
Merci par avance et désolé pour mon ignorance.

Sub Saisie(Rg As Range)
Dim T(1 To 1, 1 To 5) As Variant

    If Ecrit Then Exit Sub
    With Sheets("Agenda")
        T(1, 1) = .Cells(Rg.Row, Rg.Column + 24).Value
        T(1, 2) = .Cells(2, Rg.Column).Value
        T(1, 3) = .Cells(Rg.Row, "B").Value
       [B][U] 'T(1, 4) = Application.SpaceTime    ' Zorg / Carbon·Kevlar - Mettre ici le code pour récupérer la semaine[/U][/B]
        T(1, 5) = Rg.Value
    End With
    If Not T(1, 5) = "" Then Sauve CLng(T(1, 1)), T
End Sub

 

[p56]

Pas de soucis, il vous suffit d'écrire sur cette ligne :

T(1, 4) = .Range("G1").Value