Changer de couleur

Bonjour,

Pas tout compris mais complète le code comme cela voir si c'est ce que tu cherches

With Cells(R, 17)
.Interior.ColorIndex = 15
.Font.ColorIndex = 5

Re,

pourquoi utilises tu cette syntaxe qui démarre le code à chaque saisie

Private Sub Worksheet_Calculate

de même pourquoi deux With

With Cells(R, 17).Font
.ColorIndex = 4 'Vert
End With

With Cells(R, 17).Interior
.ColorIndex = 15

explique ce que tu veux faire à partir d'une plage exemple si je saisis une valeur entre Q2 et Q18 je souhaiterais etc ...

Re,

Si je comprends bien, la valeur que tu saisis en N20 doit s'inscrire à la suite colonne Q entre Q2 et Q26
lorsqu'on change de mois exemple le 1er novembre les valeurs N20 se réinscrivent à la suite à partir de la cellule Q2
la dernière cellule renseignée en Q se colorise en gris et police bleu

c'est cela

Re,

vite fait, clic droit sur ton onglet de feuille et colle ce code à la place de l'ancien ou des anciens, ce code gère la plage de saisie E20 à P20
transcrit la dernière saisie en colonne Q avec mise en forme mais pour automatiser le changement de mois nécessite une colonne dans mon exemple la R qui peut être masquée.
j'ai rajouté une boite de dialogue pour confirmer les changement de mois et éviter les erreurs

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [E20:P20]) Is Nothing Then
If Target = "" Then Exit Sub
If Month(Target.Offset(-19, 0)) < [R1] Or Month(Target.Offset(-19, 0)) > [R1] Then
If MsgBox("Etes-vous certain de vouloir enregistrer les données du mois de " & _
Format(Target.Offset(-19, 0), "mmmm"), vbYesNo, "Demande de confirmation") = vbYes Then
[R1:R26].ClearContents
[Q2:Q26].Interior.ColorIndex = xlNone
[Q2:Q26].Font.ColorIndex = xlAutomatic
[R1] = Month(Target.Offset(-19, 0))
[R28].End(xlUp)(-1, 0).Interior.ColorIndex = xlNone
[R28].End(xlUp)(-1, 0).Font.ColorIndex = xlAutomatic
[R28].End(xlUp)(2, 1) = Range("R28").End(xlUp) + 1 'Target
[R28].End(xlUp)(1, 0) = Target
[R28].End(xlUp)(1, 0).Interior.ColorIndex = 15
[R28].End(xlUp)(1, 0).Font.ColorIndex = 4
Else
Exit Sub
End If
Else
[R1] = Month(Target.Offset(-19, 0))
[R28].End(xlUp)(1, 0).Interior.ColorIndex = xlNone
[R28].End(xlUp)(1, 0).Font.ColorIndex = xlAutomatic
[R28].End(xlUp)(2, 1) = Range("R28").End(xlUp) + 1 'Target
[R28].End(xlUp)(1, 0) = Target
[R28].End(xlUp)(1, 0).Interior.ColorIndex = 15
[R28].End(xlUp)(1, 0).Font.ColorIndex = 4
End If
End If
End Sub

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Re,

C'est peut être parce que j'ai également automatisé ton calendrier de sorte de saisir en E1 le 1/1/et l'année et les en tête s'automatisent ce qui également permet à Excel de reconnaitre les mois

exemple sur ce fichier qu'il est encore possible d'améliorer si tu le souhaites, comme coloriser l'en-tête de saisie

https://www.cjoint.com/?CJorTXHFW9U

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Re,

Si ton code te convient, tu peux supprimer deux boucle With

Private Sub Worksheet_Calculate()
Dim C As Long, R As Long
C = Month(Now) + 4
R = [Z1].Value: If R < 2 Then R = 1
Cells(R, 17).Font.ColorIndex = 10
With Cells(R, 17).Interior
.ColorIndex = 15 'Gris Affiche la barre repère Gris clair
If Cells(20, C).Text <> Cells(R, 17).Text Then
Application.EnableEvents = False
R = R + 1: If R > 26 Then R = 2
[Z1].Value = R
Cells(R, 17).Value = Cells(20, C).Value
.ColorIndex = xlNone
Application.EnableEvents = True
End If
End With
Cells(R, 17).Font.ColorIndex = 5
End Sub

Re,

envoie toujours après on verra ce que l'on peut faire

Re,

"BOUTON POUR EFFACER LA COLONNE(Q)SANS SUPPRIMER LES FORMULES DES CELLULES"

ça ce n'est pas possible, avec clearcontents le contenu des cellules est supprimé ou il faut intervenir en amont des formules de sorte que les formules de la colonne Q soit à zéro ou vide
le mieux serait d'avoir un exemple de ton fichier que tu peux joindre avec ce lien

https://www.cjoint.com/

clic sur le lien/parcourir pour sélectionner le fichier/créer le lien reste plus qu'à coller le lien généré dans ta réponse

Re,

essaye comme cela

Sub EffaceCellule()
If MsgBox("Etes-vous certain de vouloir effacer les données de la colonne Q ", vbYesNo, "Demande de confirmation") = vbYes Then
[Q2:Q26].ClearContents
[Q2:Q26].Interior.ColorIndex = xlNone
Else
Exit Sub
End If
End Sub

Re,

non ce n'est pas la peine si le code te satisfait.

Si tu n'as plus de question, passe le statut de la discussion en résolu ou confirme le moi, je le ferai pour toi

Salut Mike-31

Merci pour ta rapide réponse, mais ca marche pas comme voulu mais ca plante pas

Entre temps, j'ai fait le code ci-dessous, j'obtiens bien ce que je souhaite

Mais le code n'ai pas beau, on peut modifier c'est clair

si tu crois svp pouvoir m'allèger ca, je veux bien car moi je n'ai pas pu faire mieux.

Merci a toi, je te souhaite la bonne soirée

Cordialement Raymond

'*** RECOPIE LA VALEUR DANS LA PLAGE LIGNE(E20:P20) MOIS PAR MOIS

Private Sub Worksheet_Calculate()
  Dim C As Long, R As Long
    C = Month(Now) + 4
    R = [Z1].Value: If R < 2 Then R = 1

'*** Ligne Q2:Q26 Colonne 17(Q)

With Cells(R, 17).Font
     .ColorIndex = 4                'Vert
End With
 
   With Cells(R, 17).Interior
          .ColorIndex = 15          'Gris    Affiche la barre repère Gris clair

      If Cells(20, C).Text <> Cells(R, 17).Text Then
        Application.EnableEvents = False
        R = R + 1: If R > 26 Then R = 2
        [Z1].Value = R
        
            Cells(R, 17).Value = Cells(20, C).Value
       
            .ColorIndex = xlNone
         
        Application.EnableEvents = True
      End If
  End With
 
With Cells(R, 17).Font
     .ColorIndex = 5                  'Bleue
End With
End Sub

Salut Mike

Merci pour ta réponse voila j'explique pour le mieux.

(1) But améliorer svp le code, car ce que j'ai fait c'est du bricolage.

je fais un suivi d'une valeur se trouvant dans la ligne 20 et en fonction du mois en cours a chaque fois que la valeur change, la valeur est copier automatiquement dans la colonne Q de Q2 à Q26

Voir svp photo ci jointe le lien ci-dessous

http://www.cjoint.com/?0Joje1nnoyk

la colonne Q est au format monétaire Rouge quand valeur négative et Vert positif

pour mieux repérer, j'ai voulu une barre grise avec la valeur changante en bleue.

la barre grise et la valeur bleue s'affiche en Q2 et au fur et a mesure que la valeur change ca descends jusqu'a Q26 puis remonte en Q2 et ainsi de suite.

Sans effacer la colonne Q (c'est volontaire)

Merci pour ton aide je te souhaite un bon début de semaine

Cordialement Raymond

Salut Mike

oui tu a bien compris, c'est bien ca

SAUF que pour novembre 2013 c'est O20
et pour décembre 2013 ca sera P20

puis pour Janvier 2014 ca sera E20 et ainsi de suite Mais toujours la ligne 20

si besoin je suis a ta dispo

a plus tard

Raymond

Ok bien vu, je te regarde un code dans l'aprem

Re salut Mike

Merci pour le code

j'ai suivi tes conseils et ca ne plante pas déja ca LOL

(1) par contre rien ne se copie dans la colonne Q ----> (Q2:Q26)

(2) j'ai simuler le mois de novembre et le changement de mois se passe bien

Pourquoi tu veux tout re-gérer ca fonctionne bien et ca va se compliquer avec l'userform et ce n'ai pas tout

t'expliquer le fonctionnement du programme ne va pas etre chose facile

c'est un peu une usine a gaz LOL cependant il fonctionne bien quand mème.

--------------------

c'est juste que je souhaitai optimiser l'affichage du repère gris et la valeur en bleue

qui suit le repère car le code que j'ai fait pour gérer ca n'ai pas terrible.

a plus tard et merci je regarde le code au cas je trouverai

bye a plus tard

Ray

Salut Mike

Merci beaucoup pour le fichier, et pour ton aide mais je ne veux pas remodifier mon programme il fonctionne très bien tout est automatiser

je souhaite svp juste savoir si il est possible d'améliorer le code ci dessous

c'est un petit plus que j'ai voulu apporter au programme.

j'ai sans doute mal formuler ma demande, j'en suis bien désolé.

Bien cordialement Ray

Private Sub Worksheet_Calculate()
  Dim C As Long, R As Long
  C = Month(Now) + 4
  R = [Z1].Value: If R < 2 Then R = 1

  With Cells(R, 17).Font
       .ColorIndex = 10                 'Vert foncé
  End With
 
       With Cells(R, 17).Interior
              .ColorIndex = 15          'Gris   Affiche la barre repère Gris clair
    
          If Cells(20, C).Text <> Cells(R, 17).Text Then
            Application.EnableEvents = False
                R = R + 1: If R > 26 Then R = 2
                [Z1].Value = R
                Cells(R, 17).Value = Cells(20, C).Value
                
                .ColorIndex = xlNone
             
            Application.EnableEvents = True
          End If
      End With
 
  With Cells(R, 17).Font
       .ColorIndex = 5                  'Bleu
  End With
End Sub

Bonjour Mike,

Merci beaucoup ca marche très bien, tu as optimiser le code chose que je n'ai pas su faire aussi bien

Bon ca marchai quand mème, mais le superflu n'étant pas obligatoire alors autant dans la mesure du possible optimiser

donc merci et désolé de t'avoir fait perdre du temps mais c'est tout de mème gentil a toi d'avoir voulu faire du mieux dans mon programme

Si tu veux dans mon programme, j'ai deux autres petits bout de codes simple que l'on pourrai optimiser si tu veux bien regarder.

Dit moi si Ok sinon c'est pas grave

Je te remercie de ta patience et pour ton aide.

A plus tard

Bien cordialement Raymond

Bonjour Mike

Merci de bien vouloir regarder

voila Quand je clic dans la cellule Q27 ca déclenche la macro ci dessous

mais ca marche pas comme je souhaiterai.

Car avec ce code j'ai bien le message de la Msgbox mais quand je clic sur la croix de Msgbox

ca efface bien la colonne Q2:Q26
et ca efface également quand je quitte la Msgbox

je voudrais svp pouvoir avoir le choix Effacer la colonne Q2:Q26 par confirmation OUI ou NON

et si possible éviter une Msgbox sinon je ferai avec
et optimiser le code par la mème occasion

Donc effacer manuellement le fond et les valeurs de la colonne Q

Merci a toi

a plus tard Mike

Cdlt Ray

'*** BOUTON POUR EFFACER LA COLONNE(Q)SANS SUPPRIMER LES FORMULES DES CELLULES
Sub EffaceCellule()
  MsgBox "Etes vous sur de vouloir effacer la colonne"
            [Q2:Q26].SpecialCells(xlCellTypeConstants, 23).ClearContents
  Range("Q2:Q26").Interior.ColorIndex = xlNone
End Sub

RE

Bien vu a ton tour, j'ai omis de te dire qu'il ni a pas de formule dans la colonne Q

juste au format monétaire Rouge quand valeur négative, Vert valeur positive

et Bleu pour mieux repérer la valeur changeante

Donc pas de formule

Merci Mike

A plus tard Ray

Re

Ok nickel ca marche comme souhaiter, Merci beaucoup Mike

Pour le fichier, je peux te l'envoyer mais avant il faut que je cache certaines infos persos

ca demande un peu de temps

dit moi et je te le prépare

Ray