Problèmes de conditions et affichage msgbox

[thespeedy20]

Bonjour le Forum,

J'ai une carte pour les congés, avec un solde d'heure, j'aimerais quand le solde de congé est à zéro, un msgbox me dise plus de congés disponibles et quand on excède le quotta d'heure , que celui-ci est dépassé....

j'ai essayé mais cela ne fonctionne pas correctement, et peut-être aussi voir si on peur améliorer ma macro, je suis débutant

merci d'avance

Oli

 

[xUpsilon]

Bonjour,

Dans quelle cellule est ta somme de tous les congés pris ?

Bonne continuation

 

[thespeedy20]

Bonjour,

On pourrait mettre la somme en P9...

 

[Dranreb]

Bonjour.
Moi je mettrais dans Module1 :

Option Explicit
Sub Ellipse7_Cliquer()
   Dim Wsh As Worksheet
   Set Wsh = ActiveSheet
   Wsh.[C11:C30,J11:J30].ClearContents
   Wsh.[D11].FormulaR1C1 = "=R9C12-RC3"
   Wsh.[D12:D30].FormulaR1C1 = "=R[-1]C-RC3"
   Wsh.[K11].FormulaR1C1 = "=R30C4-RC10"
   Wsh.[K12:K30].FormulaR1C1 = "=R[-1]C-RC10"
   With Wsh.Range("D12:D30,K11:K30")
      .FormatConditions.Delete
      .Cells(1, 1).Activate
      .FormatConditions.Add(Type:=xlExpression, Formula1:="=ESTVIDE(C12)").NumberFormat = ";;;"
      End With
   End Sub

Et dans Feuil1 (Feuil1) :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range, Zon As Range, T(), L&, Trop#, TotDisp#
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
   If Intersect([C11:C30,K11:K30], Target) Is Nothing Then Exit Sub
   Set Rng = Me.[C11:C30,J11:J30]
   TotDisp = Me.[L9].Value
   Trop = -Me.[K30].Value
   If Trop <= 0 Then Exit Sub
   If MsgBox(Trop & " heure(s) spécifiée(s) en trop vont être annulées.", vbOKCancel, Me.Name) = vbCancel Then Exit Sub
   For Each Zon In Rng.Areas
      T = Zon.Value
      For L = 1 To UBound(T, 1)
         If T(L, 1) > TotDisp Then T(L, 1) = TotDisp
         TotDisp = TotDisp - T(L, 1): Next L
      Application.EnableEvents = False
      Zon.Value = T
      Application.EnableEvents = True: Next Zon
   End Sub

 

[thespeedy20]

Bonjour,

@Dranreb, merci pour ta proposition..... juste deux petites choses, quand je remets à zero la feuille, la couleur verte ne s'efface pas... et si possible quand le solde d'heure arrive à zero, colorier la cellule en rouge

Merci d'avance pour ton aide si précieuse...

Oli

 

[Dranreb]

J'ai simplement dit que moi je ferais comme ça, c'est à dire que je rendrais impossible la saisie d'un nombre d'heures supérieur au restant, c'est tout.

 

[thespeedy20]

re,

tu peux m'aider pour résoudre le poste précédent ?

 

[Dranreb]

Peut être en ajoutant une mise en forme conditionnelle supplémentaire à la remise à zéro.

Option Explicit
Sub Ellipse7_Cliquer()
   Dim Wsh As Worksheet
   Set Wsh = ActiveSheet
   Wsh.[C11:C30,J11:J30].ClearContents
   Range("C11:D30,J11:K30").ClearContents
   Wsh.[D11].FormulaR1C1 = "=R9C12-RC3"
   Wsh.[D12:D30].FormulaR1C1 = "=R[-1]C-RC3"
   Wsh.[K11].FormulaR1C1 = "=R30C4-RC10"
   Wsh.[K12:K30].FormulaR1C1 = "=R[-1]C-RC10"
   With Wsh.Range("D11:D30,K11:K30")
      .FormatConditions.Delete
      .Cells(1, 1).Activate
      .FormatConditions.Add(Type:=xlExpression, Formula1:="=ESTVIDE(C11)").NumberFormat = ";;;"
      .FormatConditions.Add(Type:=xlExpression, Formula1:="=D11<=0").Interior.Color = &HBABAFF
      End With
   End Sub

Mais j'ai du effacer le premier solde, c'est à dire le traiter comme les autres: il n'est affiché que s'il y a des heures devant.

 

[thespeedy20]

re,

Merci , c'est que je désirais, encore une petite question : &HBABAFF cela équivaut à la couleur rouge, et pour la couleur verte....?

 

[Dranreb]

Pour la même énergie lumineuse perçue par les bâtonnets de la rétine, c'est &H6AFF6A
Vous pouvez télécharger ça pour avoir les réponses à toutes les questions de ce genre.

 

[thespeedy20]

re,

l'alerte de dépassement ne fonctionne pas sur la colonne de droite, celle de gauche, pas de soucis....

 

[Dranreb]

Je ne sais pas ce que j'ai fabriqué, j'ai testé si la cellule changée était dans la colonne K au lieu de J
Il faut : If Intersect([C11:C30,J11:J30], Target) Is Nothing Then Exit Sub

 

[thespeedy20]

re,

Nickel, cela fonctionne correctement....je te remercie vivement pour ton aide...
Bonne fin de soirée...

Oli