récupérer les codes couleurs sur mise en forme conditionnelle

[obelix77]

Bonjour à tous,

J'utilise le code ci-dessous qui me permet de récupérer le code couleur de la palette de 56 couleurs Excel, quand une cellule est remplie en couleur.

Mon problème : cette macro ne fonctionne que si les couleurs ont été mises manuellement.
Si les couleurs provienne d'une mise en forme conditionnelle ou d'un tableau d'Excel, voir un TC, cette macro considère qu'il n'y a aucune couleur.

Je suis nul en VBA. Quelqu'un pourrait m'aider?

Un grand merci à vous

Obelix77

Function Couleur(CL As Range) As Long
Couleur = CL.Interior.ColorIndex
End Function

 

[job75]

Re : récupérer les codes couleurs sur mise en forme conditionnelle

Bonjour le fil, le forum,

Pour le fichier (4) j'ai écrit :

Edit : bien noter que la fonction ne peut étudier que les cellules de la feuille active.

Avec ce fichier (5) les feuilles à étudier sont numérotées et chacune a sa feuille auxiliaire.

On peut donc utiliser des références externes à la feuille étudiée :

Function CodeCouleur(r As Range) As Range
Application.Volatile
Set CodeCouleur = Sheets("Couleurs(" & NF(r.Parent.Name) & ")").Range(r.Address)
End Function

Function NF(f$)
'détermine le numéro de la feuille
Dim i As Byte
For i = 1 To Len(f)
  If IsNumeric(Mid(f, i, 1)) Then NF = Val(Mid(f, i)): Exit For
Next
End Function

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim P As Range, t, ncol%, i&, j%
Set P = Sh.UsedRange
If P.Count = 1 Then
  t = P.DisplayFormat.Interior.ColorIndex
Else
  t = P 'matrice, plus rapide
  ncol = UBound(t, 2)
  For i = 1 To UBound(t)
    For j = 1 To ncol
      t(i, j) = P(i, j).DisplayFormat.Interior.ColorIndex
  Next j, i
End If
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si la feuille auxiliaire n'existe pas
With Sheets("Couleurs(" & NF(Sh.Name) & ")") 'feuille auxiliaire indicée
  .Cells.ClearContents 'RAZ
  .Range(P.Address) = t
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Couleurs*" Then Calculate
End Sub

Bonne journée.

 

[obelix77]

Re : récupérer les codes couleurs sur mise en forme conditionnelle

Bonjour à tous et un grand merci aussi
Ca y est, j'ai exactement ce dont j'avais besoin avec cette dernière version.
Votre participation a été incroyable. Avec un coup de chapeau spécial à job75; quelle patience!
Reste à clore ce fil et à vous dire à très bientôt avec de nouveaux besoins
Bonne journée,

 

[mécano41]

Erreur!