Code Simplifié

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Fredo P
Le #17330811
> 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



Guy72
Le #17330801
Ok merci
Bonne nuit
--
Cordialement
Guy
"Fredo P" 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







Fredo P
Le #17330961
Oupss!!!
"Guy72" %
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
Fredo P
Le #17330941
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
Fredo P
Le #17331091
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
Modeste
Le #17331541
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)))
LSteph
Le #17332591
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!
Fredo P
Le #17339791
Roh!! Les monstres comme disait mon Gd_père
"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)))
Fredo P
Le #17339981
Le §Roh!! me fait pensé à M et Mme Pudbiérofrigo ont un fils
"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)))
LSteph
Le #17340271
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


Publicité
Poster une réponse
Anonyme