Discussion :

[fred62200]

Bonjour, je n'arrive pas à faire fonctionner cette macro.
Cette macro a pour but de modifier les caractéristiques d'affichage en fonction du contenu : le gras, l'italique, le soulignement, la police et la taille de caractère.

Sub MiseEnEvidence()

Action.Execute MiseEnEvidence Until ActiveCell=""
DependingOn.Case ActiveCell
Case Is >= 10
Selection.Police.IndexColor = 3
Selection.Police.Bold = True
Case 5 To 9
Selection.Police.Underline = xlMono
Case 1 To 4
Selection.Police.Size = 18
Case 0
Selection.Police.IndexColor = 2
End DependingOn
ActiveCell.Shift(1, 0).Active
Loop

End Sub

[Philippe Tulliez]

Bonjour,
Sauf erreur de ma part, ce n'est pas du VBA mais sans doute les anciennes macro 4

[fred62200]

oui, c'est vrai, ce n'est pas du VBA, mais c'est une macro quand-même.

[fred62200]

Solution trouvée :

Public Sub MiseEnEvidenceOptimisee()
Application.ScreenUpdating = False
' Définir la feuille active et la cellIule de départ
Dim ws As Worksheet
Set ws = ActiveSheet

' Boucle sur les cellIules à partir de la cellIule active vers le bas
Dim cellI As Range
For Each cellI In ws.Range(ActiveCell, ws.Cells(ws.Rows.Count, ActiveCell.Column).End(xlUp))
If IsEmpty(cellI.Value) Then Exit For

Select Case cellI.Value
Case Is >= 10
With cellI.Font
.ColorIndex = 3 ' Rouge
.Bold = True
End With
Case 5 To 9
cellI.Font.Underline = xlUnderlineStyleSingle ' Soulignement
Case 1 To 4
cellI.Font.Size = 18 ' Taille de police
Case 0
cellI.Font.ColorIndex = 2 ' Vert
End Select
Next cellI
Application.ScreenUpdating = True
End Sub

[deedolith]

Hello,

Avec la balise Code (#) et de l'indentation, ce sera mieux:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Public Sub MiseEnEvidenceOptimisee()
	Application.ScreenUpdating = False
	' Définir la feuille active et la cellIule de départ
	Dim ws As Worksheet
	Set ws = ActiveSheet
 
	' Boucle sur les cellIules à partir de la cellIule active vers le bas
	Dim cellI As Range
	For Each cellI In ws.Range(ActiveCell, ws.Cells(ws.Rows.Count, ActiveCell.Column).End(xlUp))
		If IsEmpty(cellI.Value) Then Exit For
 
		Select Case cellI.Value
		Case Is >= 10
			With cellI.Font
				.ColorIndex = 3 ' Rouge
				.Bold = True
			End With
		Case 5 To 9
			cellI.Font.Underline = xlUnderlineStyleSingle ' Soulignement
		Case 1 To 4
			cellI.Font.Size = 18 ' Taille de police
		Case 0
			cellI.Font.ColorIndex = 2 ' Vert
		End Select
	Next cellI
	Application.ScreenUpdating = True
End Sub

Note:
La boucle For s'arrête dès qu'une cellule est vide, as-tu la garantie qu'il n'y aura jamais de cellule vide en plein milieu de la colonne ?

[fred62200]

oui, dans le cas présent, il n'y aura pas de case vide à l'intérieur de la colonne, merci pour votre aide.