Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With [D8:D27] 'plage à adapter
.Interior.Color = 12874308 'couleur de fond bleue
.Font.ColorIndex = 2 'couleur police blanche
If Intersect(ActiveCell, .Cells) Is Nothing Then Exit Sub
End With
With ActiveCell
.Interior.Color = 49407 'couleur de fond orange
.Font.ColorIndex = xlAutomatic 'couleur police noire
End With
End Sub
c'est super cool et pafait soan juste que la sélection orange doit être unique car la couleur ne concerne que la cellule sélectionner pour afficher l'infos sur la partie droite.
=>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.
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
Bon appétit, j'ai testé sur mon fichier source cela à l'air parfait faut que je paramètre tout mes liens et c'est TOP!
Petite question ! Eventuellement est ce que je peux revenir vers toi sur d'autres petites énigmes d'excel ! Si oui peut on passé en privé ou par ce fil ...
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)
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)
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
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.
@+
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.
@+