Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
 
Solution
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

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

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

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
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

job75

XLDnaute Barbatruc
Bonsoir Bruno09,
Bruno09 à dit:
Ceci fonctionne mais je ne peux plus faire de copier coller maintenant. Est-ce que tu as une solution?,
Cliquez pour agrandir...
Il suffit d'ajouter une ligne à la macro :
VB: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode Then Exit Sub 'si copier/couper
'---
Bonne nuit.
 
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

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
Merci!
 
Vote positif 0 Vote négatif

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

J
  • Question
Autres Surbrillance cellule pour doublons sur Sheets
Réponses
6
Affichages
358
jny
J
  • Résolu(e)
XL 2021 MFC cellule --> Ligne
Réponses
2
Affichages
153
Neo Hyuga
  • Question
Microsoft 365 Surlignage des cellules comportant des doublons
Réponses
3
Affichages
344
JCS32
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
498
Julien_B
J
  • 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
737
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
M
  • Résolu(e)
XL 2013 Planning perpétuel Excel
2
Réponses
17
Affichages
589
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
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…