M
michel33
Guest
bonjour
dans cette macro,j'ai integre une ligne permettant de
convertir les minuscules en majuscules;seulement la macro met
longtemps a s'executer.je pense qu'il s'agit d'un probleme de
conception de la macro,mais je ne sais pas comment l'ecrire
autrement:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub
For Each cell In Range('d3:g115')
If cell.Value = '' Then
cell.Offset(0, 1).ClearContents 'effacement
cell.Offset(0, 2).ClearContents 'effacement
cell.Offset(0, 3).Clear 'effacement
End If
If cell.Offset(0, 3).Value = 'rou' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 3 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 3 'mefc
ElseIf cell.Offset(0, 3).Value = 'ros' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 22 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 22 'mefc
ElseIf cell.Offset(0, 3).Value = 'b' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 19 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 19 'mefc
End If
cell.Value = UCase(cell.Value) 'minuscules en majuscules
Next cell
End Sub
je cherche depuis pas mal de temps,mais pas de solution
merci pour l'aide
michel33
dans cette macro,j'ai integre une ligne permettant de
convertir les minuscules en majuscules;seulement la macro met
longtemps a s'executer.je pense qu'il s'agit d'un probleme de
conception de la macro,mais je ne sais pas comment l'ecrire
autrement:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub
For Each cell In Range('d3:g115')
If cell.Value = '' Then
cell.Offset(0, 1).ClearContents 'effacement
cell.Offset(0, 2).ClearContents 'effacement
cell.Offset(0, 3).Clear 'effacement
End If
If cell.Offset(0, 3).Value = 'rou' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 3 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 3 'mefc
ElseIf cell.Offset(0, 3).Value = 'ros' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 22 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 22 'mefc
ElseIf cell.Offset(0, 3).Value = 'b' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 19 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 19 'mefc
End If
cell.Value = UCase(cell.Value) 'minuscules en majuscules
Next cell
End Sub
je cherche depuis pas mal de temps,mais pas de solution
merci pour l'aide
michel33