changer les valeurs en fonction de la couleur

[Bricoltou]

Bonsoir Le Forum

Nous venons de décoller pour 2010 et je vous souhaite une bonne année ,une excellente santé et que 2010 réponde a tout vos souhaits .
Avec votre aide j'ai creer cette macro que je voudrai modifier .
Toute les cellules avec des couleurs prennent la même valeur alors que je voudrai que certaines couleurs prennent d'autres valeurs ( Fichier Joint)
Merci d'avance pour votre aide

Private Sub Worksheet_Activate()
With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
End With
ActiveSheet.Unprotect Password:="Terminal"
Range("A5").Select
ActiveSheet.Range("B9:AF39").ClearContents
ActiveSheet.Range("B9:AF39").Interior.ColorIndex = xlNone
Dim ligne As Integer
Dim n As Integer
Dim m As Integer
tablo = Sheets("Absence_Chauffeur").Range("A2:E" & Sheets("Absence_Chauffeur").Range("A65536").End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
Set c = ActiveSheet.Columns(1).Find(Trim(tablo(n, 1)), LookIn:=xlValues, lookat:=xlWhole)
ligne = c.Row
Set d = Sheets("Chauffeur").Range("A41:A55").Find(tablo(n, 5), LookIn:=xlValues, lookat:=xlWhole)
For m = 2 To 32
  If ActiveSheet.Cells(6, m) >= Day(tablo(n, 3)) And ActiveSheet.Cells(6, m) <= Day(tablo(n, 4)) Then
    ActiveSheet.Cells(ligne, m) = "7,10"
   If Not d Is Nothing Then
      ActiveSheet.Cells(ligne, m).Interior.ColorIndex = d.Interior.ColorIndex
      ActiveSheet.Cells(ligne, m).Font.Size = 12
      ActiveSheet.Cells(ligne, m).Font.Bold = True
      ActiveSheet.Cells(ligne, m).HorizontalAlignment = xlCenter
    End If
  End If
Next m
Next n
ActiveSheet.Protect Password:="Terminal"
With Application
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
End With
End Sub

 

[job75]

Re : changer les valeurs en fonction de la couleur

Bonsoir Bricoltou,

Pas évident si vous bricolez aussi la protection VBA...

A+

 

[Bricoltou]

Re : changer les valeurs en fonction de la couleur

Bonsoir Le Forum ,Job75

Oups je pense que c'est les restes des fêtes , le MDP pour le code est Nicole😱
le mot de passe pour la Feuille est Terminal
Merci Job75 pour ton aide

@+

Bricoltou

 

[job75]

Re : changer les valeurs en fonction de la couleur

Re,

Il suffit de compléter la plage I41:I55 avec les valeurs à appliquer et d'ajouter une ligne de code :

If Not d Is Nothing Then
   [COLOR="Red"]ActiveSheet.Cells(ligne, m) = d.Offset(, 8)[/COLOR] 'valeurs en colonne I

Voir le fichier modifié.

Bonne nuit.

 

[Bricoltou]

Re : changer les valeurs en fonction de la couleur

Bonjour le Forum,Job75

Merci Job75 pour ta réponse et ton aide 😉

à+

Bricoltou