Ce navigateur n’est plus pris en charge.
Effectuez une mise à niveau vers Microsoft Edge pour tirer parti des dernières fonctionnalités, des mises à jour de sécurité et du support technique.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Bonjour,
ai défini des couleurs conditionnelles de fond sur plusieurs cellules. Selon la couleur affichée je fais des calculs.
voici la fonction ColorIndexOfCF (qui a été développée par un membre de la communauté) qui donne souvent le bon résultat mais malheureusement pas toujours. Ai un pb lorsque la couleur est un rouge pur (RVB ; 255,0,0), la fonction me donne #VALEUR!
============================================================
Function ColorIndexOfCF(Rng As Range, Optional OfText As Boolean = False) As Integer
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorIndexOfCF = Rng.Font.ColorIndex
Else
ColorIndexOfCF = Rng.Interior.ColorIndex
End If
Else
If OfText = True Then
ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
Else
ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
End If
End If
End Function
Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant
If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Range(Temp).Value And _
Rng.Value <= Range(Temp2).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value = Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <> Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
(CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Range(Temp).Value And _
Rng.Value >= Range(Temp2).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next Ndx
End If
ActiveCondition = 0
End Function
Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
If Right(CF, 2) = """""" Then
Temp = Mid(CF, 3, Len(CF) - 3)
Else
Temp = Mid(CF, 3, Len(CF) - 2)
End If
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
Private Function GetCFInteriorColor(rngCel As Range) As Long
' Initial version from someone else
Dim strHcolor As String
' Get Hex interior color as String
strHcolor = Right("000000" & Hex(rngCel.DisplayFormat.Interior.Color), 6)
' Convert each Hex portion to a Long & pass them to the RGB function
GetCFInteriorColor = RGB(CLng("&H" & Right(strHcolor, 2)), _
CLng("&H" & Mid(strHcolor, 3, 2)), _
CLng("&H" & Left(strHcolor, 2)))
End Function
=========================================================
Famille de feuilles de calcul Microsoft avec des outils pour l’analyse, le graphique et la communication des données.
Question verrouillée. Cette question a été migrée à partir de la Communauté Support Microsoft. Vous pouvez voter pour indiquer si elle est utile, mais vous ne pouvez pas ajouter de commentaires ou de réponses ni suivre la question.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(108.80000000000001, 78%, 20%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3ED%3C/text%3E%3C/svg%3E)
Bonjour,
Apparemment, VBA comporte une anomalie dans Excel 2007. Pour la première condition (=""), c'est la 3e condition qui est reprise :
Le n° de la condition est donné par Ndx. Alors que Excel 2016 gère bien cette condition :
Compare Operator, Formula1 et Formula2 pour les deux versions.
Daniel
J'ai peut-être mal compris. J'ai 26/03/18 09:00 en B87 (remplissage rouge pétant) et 3 en B93.
Je n'ai pas compris le reste des explications...
Daniel
le pb persiste.
si tu peux voir, mon fichier est sur : https://we.tl/xOH59QBnHm
explications fichier Service UR2
Voir les cours jour J, J+1, J+2, J+I1
à l'ouverture I1=0 (pour que J = aujourd'hui) et D1=8 (voir les cours de la semaine)
en B87 ai cours le 26 mars, aujourd'hui sommes le 6 donc mettre 20 en I1
(en C87 le 28 mars ; mettre 22 en I1...)
si aujourd'hui + I1 =26 alors B87 sur fond rouge mais en B93 ai #VALEUR! au lieu de 3
en cliquant sur la partie supérieure de D1 (photo AL2:AM6), récapitulatif du travail de J à J+I1
légendes : effu=effectué - prés = présenciel - comp = complémentaires.
Essaie :
Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant
If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= Temp And _
CDbl(Rng.Value) <= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Range(Temp).Value And _
Rng.Value <= Range(Temp2).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value = Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <> Range(Temp).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
(CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Range(Temp).Value And _
Rng.Value >= Range(Temp2).Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next Ndx
End If
ActiveCondition = 0
End Function
'--------------------------------------------------------------------
Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
If Right(CF, 2) = """""" Then
Temp = Mid(CF, 3, Len(CF) - 3)
Else
Temp = Mid(CF, 3, Len(CF) - 2)
End If
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
If Temp = "" Then Temp = Evaluate(CF)
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
'-------------------------------------------------------------------
Private Function GetCFInteriorColor(rngCel As Range) As Long
' Initial version from someone else
Dim strHcolor As String
' Get Hex interior color as String
strHcolor = Right("000000" & Hex(rngCel.DisplayFormat.Interior.Color), 6)
' Convert each Hex portion to a Long & pass them to the RGB function
GetCFInteriorColor = RGB(CLng("&H" & Right(strHcolor, 2)), _
CLng("&H" & Mid(strHcolor, 3, 2)), _
CLng("&H" & Left(strHcolor, 2)))
End Function
Daniel
Bonjour,
Est-ce que tu peux poster le classeur ?
Daniel