Libre Office Calc ou Excel 2010 - Extraire couleur d'une cellule

Bonjour à tous

Je récupère des tableaux de données par le web.

Leur classement est codé par couleurs : magenta pour la 1ère, jaune pour la 2ème ...

Ce sont les couleurs de base : magenta, jaune, vert, bleu, cyan, rouge.

J'aimerai trouver une formule qui me donne les valeurs par leurs couleurs du genre, pour un résultat en E4 =si(couleur(E4)=magenta;1;"")

E4 : une cellule a analyser

Ligne : 1 entête des classements 1er, 2em, 3em ... de base

Résultat : Le magenta en E4 me dit que le 14 est en 1 (1ère position du classement final).

J'ai beaucoup cherché, même sur ce site mais je ne trouve pas.

Merci par avance de votre aide.

Lionel

Hello,
je ne sais pas si cela est faisable par formule mais en VBA cela n'est pas très compliqué :

Sub ChangeValueBasedOnCellColor()
Dim rg As Range
Dim xRg As Range
Set xRg = Selection.Cells
Application.DisplayAlerts = False
xRg.Copy
Range("B17").PasteSpecial xlPasteAll
For Each rg In Selection
     With rg
             Select Case .Interior.Color
                         Case Is = RGB(255, 0, 255) ' Magenta
                                  .Value = 1
                         Case Is = RGB(255, 255, 0) ' Jaune
                                  .Value = 2
                         Case Is = RGB(0, 255, 0) ' Vert
                                  .Value = 3
                         Case Is = RGB(0, 255, 255) ' Cyan
                                  .Value = 4
                         Case Is = RGB(255, 0, 0) ' Rouge
                                  .Value = 5
                         Case Is = RGB(255, 255, 255) ' blanc
                                  .Value = ""
              End Select
       End With
Next
Application.DisplayAlerts = False
End Sub

Le principe :
1- On sélectionne dans la feuille , la zone que l'on veut traiter
2- On lance la macro
3- La zone sélectionnée est recopiée en B17
4- On balaie toute la zone recopiée et on change la valeur des cellules suivant la couleur de fond des cellules.

codecouleur

Et pour du Basic LibreOffice en utilisant des plages fixes :
REM ***** BASIC *****

Sub ChangeValueBasedOnCellColor()
Dim oSheet As Object, source As Object, destination as Object
Dim selection As Object,x as Integer, y as Integer, v, c as Object
oSheet = thisComponent.Sheets.getByIndex(0)
selection = ThisComponent.CurrentSelection.getRangeAddress()
source = oSheet.getCellRangeByName("B1:M4").getRangeAddress()
destination = oSheet.getCellRangeByName("B17").getCellAddress()
oSheet.copyRange( destination , source )
for Each c in oSheet.getCellRangeByName("B18:M21").queryVisibleCells().getCells()
    Select case c.CellBackColor
        Case RGB(255, 0, 255): ' Magenta
            c.Value = 1
        Case RGB(255, 255, 0) ' Jaune
            c.Value = 2
        Case RGB(0, 255, 0) ' Vert
            c.Value = 3
        Case RGB(0, 255, 255) ' Cyan
            c.Value = 4
        Case RGB(255, 0, 0) ' Rouge
           c.Value = 5
        Case -1 ' blanc
           c.String = ""
    End Select
Next c
End Sub

En pièces jointes les classeurs Excel et LibreOffice

Ami calmant, J.P

Voici la version avec sélection ( comme avec Excel) pour calc LibreOffice :

Sub ChangeValueBasedOnCellColor()
    Dim oSheet As Object, source As Object, destination as Object, c as Object
    oSheet = thisComponent.Sheets.getByIndex(0)
    source = ThisComponent.CurrentSelection.getRangeAddress()
    destination =  oSheet.getCellRangeByName("B17").getCellAddress()
    oSheet.copyRange( destination , source )
    for Each c in oSheet.getCellRangeByPosition(destination.Column, _
                         destination.Row, _
                         destination.Column + source.EndColumn - source.StartColumn, _
                         destination.Row +  source.EndRow - source.StartRow).queryVisibleCells().getCells()
      Select case c.CellBackColor
           Case RGB(255, 0, 255):  ' Magenta
                c.Value = 1
           Case RGB(255, 255, 0) ' Jaune
                c.Value = 2
           Case RGB(0, 255, 0) ' Vert
                c.Value = 3
           Case RGB(0, 255, 255) ' Cyan
                c.Value = 4
           Case RGB(255, 0, 0) ' Rouge
                c.Value = 5
           Case -1 ' blanc
                c.String = ""
      End Select
    Next c
End Sub

Bonjour,

Merci, j'ai trouvé une partie de ma réponse ... la "formule" dans EXCEL n'existe (apparemment) pas, donc il faut passer par une macro comme vous le proposez.

Je suis de la vieille école, mes macros sont en langage Excel 4 (je ne maitrise pas bien Visual Basic),

j'en ai récupéré une que j'ai adaptée, ça m'a pris 10 minutes et c'est nickel.

Avec cette macro, je fais une boucle pour parcourir toutes les cellules que je veux, passer à la ligne suivante et je donne le N° d'ordre voulu aux cases selon les couleurs.

C'est parfait !!

Je met une condition "fin" pour que ça s'arrête.

Classement
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4))
=SELECTIONNER("LC(1)")
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4))
=SELECTIONNER("LC(1)")
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3))
=SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4))
…/… etc, etc selon le tableau d'origine
=SELECTIONNER("L(1)C(-7)") passage ligne suivante
=SI(CELLULE.ACTIVE()="Fin";ARRETER())
=ATTEINDRE(Classement) boucle

Merci pour votre aide et les macros.

Cordialement

Lionel

Rechercher des sujets similaires à "libre office calc 2010 extraire couleur"