Worksheet_SelectionChange & Worksheet_Change

[momo2394]

Bonjour à tous

Voici quelques lignes de code qui fonctionnent très bien en revanche la ligne de code pour les majuscules ne fonctionne pas j'ai essayé de l'integrer dans Worksheet_Change mais cela freine le programme
Merci de votre aide


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim derlig As Long, cellule As Range
If Intersect(Target, Range("B1")) Is Nothing Then: Exit Sub

Columns(2).Interior.ColorIndex = 0
derlig = Range("B108").End(xlUp).Row
For Each cellule In Range(Cells(1, 2), Cells(derlig, 2))
If Left(cellule, 1) = "*" Then
cellule.Interior.ColorIndex = 36
End If
Next


End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 18 Then
If UCase(Target) <> "" Then
Target.Offset(0, -1).FormulaArray = "=IF(RC[1]=0,"""",PROPER(TEXT(RC[1],""jjj"")))"

Else
If UCase(Target) = "" Then
Target.Offset(0, -1).ClearContents
Application.EnableEvents = True

End If
End If
End If

End Sub

'Dim Cell As Range
'If Intersect(Target, Range("A4:C2004,E4:E2004,H4:H2004,J42004,S4:U2004")) Is Nothing Then Exit Sub
'Application.EnableEvents = False
'For Each Cell In Target
'If VarType(Cell) = vbString And Not Cell.HasFormula Then Cell = UCase(Cell)
'Next Cell

 

[jpb388]

Re : Worksheet_SelectionChange & Worksheet_Change

bonjour à tous
formule matricielle

Target.Offset(0, -1).FormulaArray = "=IF(RC[1]=0,"""",PROPER(TEXT(RC[1],""jjj"")))"

formule normale

 Target.Offset(0, -1).Formula = "=IF(RC[1]=0,"""",PROPER(TEXT(RC[1],""jjj"")))"

 

[momo2394]

Re : Worksheet_SelectionChange & Worksheet_Change

Bonjour jpb388

Merci mais la formule fonctionnait déjà, je veux seulement résoudre le problème des majuscules

 

[jpb388]

Re : Worksheet_SelectionChange & Worksheet_Change

re
c'est upper au lieu de proper

 

[momo2394]

Re : Worksheet_SelectionChange & Worksheet_Change

Merci encore jpb388
mais ce n'est pas ce que j'ai demandé

C'est simplement cette ligne de code que je n'arrive pas à inserer dans le programme

Dim Cell As Range
If Intersect(Target, Range("A4:C2004,E4:E2004,H4:H2004,J42004,S4:U200 4")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Target
If VarType(Cell) = vbString And Not Cell.HasFormula Then Cell = UCase(Cell)
Next Cell

dès que je l'insère dans Worksheet_SelectionChange ou dans Worksheet_Change, elle freine le programme et ignore complètement la ligne de code suivante:

If Target.Column = 18 Then
If UCase(Target) <> "" Then
Target.Offset(0, -1).FormulaArray = "=IF(RC[1]=0,"""",PROPER(TEXT(RC[1],""jjj"")))"

Else
If UCase(Target) = "" Then
Target.Offset(0, -1).ClearContents
Application.EnableEvents = True

End If
End If
End If

End Sub

Merci d'avance

 

[jpb388]

Re : Worksheet_SelectionChange & Worksheet_Change

Bonjour à tous
Tes macro fonctionnent elle ne répondent pas à tes désirs alors met un classeur avec un exemple concret une feuille j'ai ça et une autre feuille je souhaite ça
avec les explications qui faut ou il faut