Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

ReneDav14000

XLDnaute Occasionnel
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 :
VB:
Selection.Interior.Color = RGB(0,255,0) 'Vert'

Code où doit-être insérée cette instruction :
Code:
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

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

Pièces jointes

  • CalendAgenda.xlsm
    41.9 KB · Affichages: 3

patricktoulon

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

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

XLDnaute Occasionnel
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.
 

ReneDav14000

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

XLDnaute Occasionnel
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.
 

Pièces jointes

  • Hebdo_ReneDav_.xlsm
    48.3 KB · Affichages: 7

ReneDav14000

XLDnaute Occasionnel
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.

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

ReneDav14000

XLDnaute Occasionnel
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.
VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…