Microsoft 365 Code VBA pour cellule en surbrillance

B

Bruno09

XLDnaute Nouveau
Bonjour, j'ai un code vba pour mettre en surbrillance la cellule active. Certaines de mes cellules sont d'une autre couleurs que la surbrillance. Le problème est que maintenant je ne peux plus ajouter de la couleur ou changer la couleur de mes cellules.
Est-ce qu'on peut m'aider svp?
Voici le code

Merci
1614892773624.png
 
Solution
job75
En fait avec cette macro qui nomme la cellule active on peut faire cohabiter autant de MFC que l'on veut :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode Then Exit Sub 'si copier/couper
Dim fc As FormatCondition
'---supprime la MFC---
If TypeName([CA]) = "Range" Then
    For Each fc In [CA].FormatConditions
        If fc.Interior.Color = vbBlack Then fc.Delete
    Next
End If
'---crée la MFC---
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
ActiveCell.FormatConditions(ActiveCell.FormatConditions.Count).SetFirstPriority
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold =...
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonsoir Bruno09,

En créant une MFC sur la cellule active :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete 'RAZ
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
End With
End Sub
Mais on ne peut pas créer d'autres MFC sur la feuille.

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
La macro précédente est à placer dans le code d'une feuille de calcul.

Si on veut l'appliquer à toutes les feuilles du classeur placer dans ThisWorkbook :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveCell.Parent.Cells.FormatConditions.Delete 'RAZ
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
End With
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonsoir.
Une autre proposition :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   Dim CelluleSurbrillance As Range, CouleurPropre As Long
   On Error Resume Next
   Set CelluleSurbrillance = Sh.[CelluleSurbrillance]
   If Err = 0 Then If CelluleSurbrillance.Interior.Color = &HFFA5& _
      Then CelluleSurbrillance.Interior.Color = Sh.[CouleurPropre]
   On Error GoTo 0
   Set CelluleSurbrillance = Target(1, 1)
   Sh.Names.Add "CelluleSurbrillance", CelluleSurbrillance
   Sh.Names.Add "CouleurPropre", CelluleSurbrillance.Interior.Color
   CelluleSurbrillance.Interior.Color = &HFFA5&
   End Sub
 
Vote positif 0 Vote négatif
B

Bruno09

XLDnaute Nouveau
job75 à dit:
La macro précédente est à placer dans le code d'une feuille de calcul.

Si on veut l'appliquer à toutes les feuilles du classeur placer dans ThisWorkbook :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveCell.Parent.Cells.FormatConditions.Delete 'RAZ
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
End With
End Sub
Cliquez pour agrandir...
Bonjour Job75,
Ceci fonctionne mais je ne peux plus faire de copier coller maintenant. Est-ce que tu as une solution?
Merci,
 
Vote positif 0 Vote négatif
B

Bruno09

XLDnaute Nouveau
Bonjour Job75,
J'ai un autre souci. Dans ma colonne O j'ai une formule qui calcule le nombre de caractère de la colonne D et si le nombre est plus grand que 40 j'ai une mise en forme conditionnel et la cellule devient jaune et le texte en rouge mais avec le code de surbrillance cela disparaît. J'ai beau essayé de rajouter une ligne au code mais je n'y arrive pas. Est-ce que tu peux encore une fois m'aider?
Merci d'avance!
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Bruno09, le forum,

Cette macro, toujours dans ThisWorkbook, crée les 2 MFC :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode Then Exit Sub 'si copier/couper
Application.ScreenUpdating = False
Cells.FormatConditions.Delete 'RAZ
'---1ère MFC, en colonne O--
[O:O].FormatConditions.Add xlExpression, Formula1:="=--$O1>40"
With [O:O].FormatConditions(1)
    .Interior.Color = vbYellow 'fond jaune
    .Font.Color = vbRed 'police rouge
    .Font.Bold = True 'gras
End With
'---2ème MFC, sur la cellule active---
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
ActiveCell.FormatConditions(ActiveCell.FormatConditions.Count).SetFirstPriority
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
    .StopIfTrue = True
End With
End Sub
Edit : "=--$O1>40" est plus simple.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
B

Bruno09

XLDnaute Nouveau
job75 à dit:
Bonjour Bruno09, le forum,

Cette macro, toujours dans ThisWorkbook, crée les 2 MFC :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode Then Exit Sub 'si copier/couper
Application.ScreenUpdating = False
Cells.FormatConditions.Delete 'RAZ
'---1ère MFC, en colonne O--
[O:O].FormatConditions.Add xlExpression, Formula1:="=N($O1)*($O1>40)"
With [O:O].FormatConditions(1)
    .Interior.Color = vbYellow 'fond jaune
    .Font.Color = vbRed 'police rouge
    .Font.Bold = True 'gras
End With
'---2ème MFC, sur la cellule active---
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
ActiveCell.FormatConditions(ActiveCell.FormatConditions.Count).SetFirstPriority
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
    .StopIfTrue = True
End With
End Sub
A+
Cliquez pour agrandir...
Merci!
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
En fait avec cette macro qui nomme la cellule active on peut faire cohabiter autant de MFC que l'on veut :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode Then Exit Sub 'si copier/couper
Dim fc As FormatCondition
'---supprime la MFC---
If TypeName([CA]) = "Range" Then
    For Each fc In [CA].FormatConditions
        If fc.Interior.Color = vbBlack Then fc.Delete
    Next
End If
'---crée la MFC---
ActiveCell.FormatConditions.Add xlExpression, Formula1:=1
ActiveCell.FormatConditions(ActiveCell.FormatConditions.Count).SetFirstPriority
With ActiveCell.FormatConditions(1)
    .Interior.Color = vbBlack 'fond noir
    .Font.Color = vbWhite 'police blanche
    .Font.Bold = True 'gras
    .StopIfTrue = True
End With
ActiveSheet.Names.Add "CA", ActiveCell 'nom défini DANS LA FEUILLE  pour mémoriser la cellule
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

J
  • Question
Autres Surbrillance cellule pour doublons sur Sheets
Réponses
6
Affichages
358
jny
J
Neo Hyuga
  • Résolu(e)
XL 2021 MFC cellule --> Ligne
Réponses
2
Affichages
153
Neo Hyuga
Neo Hyuga
JCS32
  • Question
Microsoft 365 Surlignage des cellules comportant des doublons
Réponses
3
Affichages
344
JCS32
JCS32
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
497
Julien_B
J
Ferbank
  • Question
XL 2019 problème d'automatisation d'attribution couleur d'une cellule en rapport d'une valeur texte d'une autre cellule
Réponses
10
Affichages
736
Ferbank
Ferbank
T
  • Question
XL 2021 Additionner la couleur du fond et la police de plusieurs cellule en vba
Réponses
7
Affichages
337
Tophe2
T
Z
  • Question
XL 2021 InputBox and focus à la fin de la ligne d'une valeur par défaut
Réponses
4
Affichages
272
zedude
Z
J
  • Question
Microsoft 365 Mise en forme conditionnelle
Réponses
7
Affichages
397
job75
job75
M
  • Résolu(e)
XL 2013 Planning perpétuel Excel
2
Réponses
17
Affichages
587
Manutela
M
M
  • Question
XL 2021 mise en forme conditionnelle des cellules quand une autre est sélectionnée
Réponses
5
Affichages
380
marco22
M

Membres actuellement en ligne

13 membres et 117 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 146
Messages
2 116 755
Membres
112 850
dernier inscrit
hfhgfhg