Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Bonjour
Avec cette procédure
Sub Changecolor
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim I&
For i = 1 sheets.count
with activesheet
.cells.interior.colorindex= 33 'par exemple
end with
next
Application.Calculation = xlCalculationAutomatic
End Sub
Cordialement
Flyonets
Sub ConditionCouleur()
Dim S As Worksheet
Dim R As Range
For Each S In Worksheets
For Each R In S.UsedRange
If R.Interior.ColorIndex = 40 Then
With R.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
End If
Next
Next
End Sub
Cordialement
PS Ceci ne modifie que les cellules couleur saumon comme indiqué dans ton fichier exemple. Ce que tu indiques dans ton message est totalement différent.
Merci beaucoup
Cela fonctionne parfaitement
Je vais partir de cela pour permette à l'utilisateur de modifier lui même certains paramètres de l'application
Bonne journée
Yves
Bonjour,
Comment pour être plus efficace remplacer Worksheet
par ZoneTrait = Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
de ne façon à ne traiter que les cellules utilisées
Merci dra72 - voila la solution retenue - Bonne journée
Private Sub Mofi_Couleur_Cell()
Application.ScreenUpdating = False
Dim Cellules As Range
On Error Resume Next
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
For Each Cellules In Selection
If Cellules.Interior.ColorIndex = 40 Then
With Cellules.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
End If
Next Cellules
Application.Goto Range("A1"), True '
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD