XL 2016 Changement couleur cellule sélectionné

soan à dit:

@Michest

voici la nouvelle version. 🙂 (c'est une version sans MFC)

soan

Cliquez pour agrandir...

soan à dit:

donc même si y'a des groupes différents, faut faire
comme si y'en avait qu'un seul, c'est bien ça ?

soan

Cliquez pour agrandir...

Staple1600 à dit:

Re

=>Michest
Avec cette version, la plage de cellules n'est pas figée
Tu sélectionnes par le biais d'un InputBox.
(Il faut sélectionner les cellules avec la souris quand l'InputBox s'affiche)

VB:

Sub Créer_MFC_v2()
Dim Rng As Range
Set Rng = Application.InputBox("Plage de cellules concernées par la MFC?", "Surbrillance Cellue Active", , , , Type:=8)
Rng.FormatConditions.Add Type:=xlExpression, Formula1:="=ADRESSE(LIGNE();COLONNE())=CELLULE(""adresse"")"
With Rng.FormatConditions(1).Borders
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlThin
End With
Rng.FormatConditions(1).Interior.Color = 65535
End Sub

NB:
Il faudra toujours penser à mettre également la procédure évènementielle Selection_Change() dans la feuille.

Cliquez pour agrandir...

Michest à dit:

Merci à toi Staple1600 je regarde et te dis.

Cliquez pour agrandir...

Michest à dit:

je t'ai répondu

Cliquez pour agrandir...

soan à dit:

@Michest

voilà, cette fois, ça devrait être ok ! 😊 je te laisse tester et vérifier. 😉

(c'était pas évident à cause des nombreuses fusions ! 🙄)

soan

Cliquez pour agrandir...

soan à dit:

@Michest

ok, merci pour ton retour du post #40 ! 😊

j'vais aller dîner 🍔, alors j'lirai ton autre retour plus tard...

soan

Cliquez pour agrandir...

soan à dit:

@Michest

j'suis ravi qu'ça marche bien sur ton fichier source ! 😊

bien sûr, tu peux revenir pour d'autre énigmes excel, mais sur le forum,
car c'est interdit par la charte d'aider en privé ; d'autre part, comme
je ne sais pas tout faire, je ne peux jamais rien garantir d'avance ! 😉

(c'est aussi pour ça que j'préfère choisir moi-même mes sujets : j'essaye de répondre
quand c'est dans mes compétences, et si j'en ai le temps)

soan

Cliquez pour agrandir...

soan à dit:

@Michest

voilà, cette fois c'est ok ! 😊 (Michest l'a testé et vérifié)

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo Fin 'pour éviter l'erreur due à ton fichier image sur F:
  Const c01& = 12874308 'couleur 1 : bleu
  Const c02& = 49407    'couleur 2 : jaune
  Dim plg As Range, adresselien$
  Application.ScreenUpdating = 0
  With Target
    If .CountLarge <> 3 Then GoTo 1
    If .Column <> 3 Then GoTo 1
    Set plg = Range("C28:E28, C33:E36, C41:E41, C46:E53")
    If Intersect(Target, plg) Is Nothing Then GoTo 1
    ActiveSheet.Unprotect
    plg.Interior.Color = c01: plg.Font.ColorIndex = 2
    With Range(.Address(0, 0))
      .Interior.Color = c02: .Font.ColorIndex = 0
    End With
    ActiveSheet.Protect
  End With

1 Range("H7").Select
   '... suite du code VBA initial

Fin:
End Sub

soan

Cliquez pour agrandir...

Michest à dit:

Bonsoir SOAN,

En fait dans mon projet quand j'applique ton code qui fonctionne très bien pour les couleurs j'ai une fenêtre qui me demande d'ôter la protection quand je veux naviguer sur les items.
Merci.
@+

Cliquez pour agrandir...