Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Code Simplifié

12 réponses
Avatar
Guy72
Bonsoir,
Peut-on simplifier ce code ?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then Exit
Sub
If Target = "Guy" Then
Range(Cells(Target.Row, 4), Cells(Target.Row,
4)).Interior.ColorIndex = 16
Range(Cells(Target.Row, 4), Cells(Target.Row, 4)).Font.ColorIndex =
16
Exit Sub
End If

Fin:
End Sub

Merci de votre aide
--
Cordialement
Guy

10 réponses

1 2
Avatar
Fredo P
> Peut-on simplifier ce code ?


non mais on peut l'améliorer
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
' On Error GoTo fin ' facultatif
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then Exit
Sub
With Target
If .Value = "Guy" Then
.Interior.ColorIndex = 16
.Font.ColorIndex = 16
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlNone
End If
End With
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then
Exit Sub
If Target = "Guy" Then
Range(Cells(Target.Row, 4), Cells(Target.Row,
4)).Interior.ColorIndex = 16
Range(Cells(Target.Row, 4), Cells(Target.Row, 4)).Font.ColorIndex =
16
Exit Sub
End If

Fin:
End Sub

Merci de votre aide
--
Cordialement
Guy



Avatar
Guy72
Ok merci
Bonne nuit
--
Cordialement
Guy
"Fredo P" a écrit dans le
message de news:
Peut-on simplifier ce code ?


non mais on peut l'améliorer
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
' On Error GoTo fin ' facultatif
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then Exit
Sub
With Target
If .Value = "Guy" Then
.Interior.ColorIndex = 16
.Font.ColorIndex = 16
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlNone
End If
End With
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then
Exit Sub
If Target = "Guy" Then
Range(Cells(Target.Row, 4), Cells(Target.Row,
4)).Interior.ColorIndex = 16
Range(Cells(Target.Row, 4), Cells(Target.Row, 4)).Font.ColorIndex
= 16
Exit Sub
End If

Fin:
End Sub

Merci de votre aide
--
Cordialement
Guy







Avatar
Fredo P
Oupss!!!
"Guy72" a écrit dans le message de news:
%
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
On Error GoTo fin
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then GoTo
fin
With [D4]
If .Value = "Guy" Then
.Interior.ColorIndex = 16
.Font.ColorIndex = 16
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlNone
End If
End With
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Avatar
Fredo P
Bonne nuit Guy,
Pour demain je tenais à te signaler que ta solution dans Workbook ne peut
pas obtenir ce que tu espérais obtenir et que dans ma solution que je t'ai
proposé il faur remplacer le "Exit sub" par "Goto fin"
Il est bien entendu que ce code appartient au code de "Feuil"

Le code revu et corrigé

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then GoTo
fin
With Target
If .Value = "Guy" Then
.Interior.ColorIndex = 16
.Font.ColorIndex = 16
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlNone
End If
End With
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Avatar
Fredo P
Ce coup ci me parait le bon, c'est le 4ième , bien heureux si tu ne les vois
pas car j'en ai supprimés 2.
Ce code est bien entendu à mettre dans le code de la feuille concernée.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Goto fin ' ne serait pas facultatif si je n'avait pas changé la
valeur de .Font.ColorIndex
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Intersect(Target, Range("D4")) Is Nothing Then GoTo
fin
With Target
If .Value = "Guy" Then
.Interior.ColorIndex = 16
.Font.ColorIndex = 16
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End If
End With
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Avatar
Modeste
Bonsour® Fredo P avec ferveur ;o))) vous nous disiez :


With Target
.Interior.ColorIndex = IIf(.Value="Guy",16, xlNone)
.Font.ColorIndex = IIf(.Value="Guy",16, xlNone)
End With

--
--
@+
;o)))
Avatar
LSteph
Bonjour,

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, [d4]) Is Nothing Then
With [d4]
.Interior.ColorIndex = IIf(UCase(.Value) = "GUY", 16, xlNone)
.Font.ColorIndex = IIf(UCase(.Value) = "GUY", 16, xlAutomatic)
End With
End If
End Sub




--
'lSteph


...selon ce que j'ai cru comprendre, donc:

.. pour guy ou Guy ou GUY,.. hop! masqué,...mais sinon, avec ferveur je
pense qu'il faut y voir et non tout mettre sans couleur et que ça
marche même si un drôle entre guy dans plusieurs cellules à la fois!
Avatar
Fredo P
Roh!! Les monstres comme disait mon Gd_père
"Modeste" a écrit dans le message de news:

Bonsour® Fredo P avec ferveur ;o))) vous nous disiez :


With Target
.Interior.ColorIndex = IIf(.Value="Guy",16, xlNone)
.Font.ColorIndex = IIf(.Value="Guy",16, xlNone)
End With

--
--
@+
;o)))
Avatar
Fredo P
Le §Roh!! me fait pensé à M et Mme Pudbiérofrigo ont un fils
"Modeste" a écrit dans le message de news:

Bonsour® Fredo P avec ferveur ;o))) vous nous disiez :


With Target
.Interior.ColorIndex = IIf(.Value="Guy",16, xlNone)
.Font.ColorIndex = IIf(.Value="Guy",16, xlNone)
End With

--
--
@+
;o)))
Avatar
LSteph
la fils c'est rho..ger la fille rha..maya

;o)

Fredo P a écrit :
Le §Roh!! me fait pensé à M et Mme Pudbiérofrigo ont un fils


1 2