problème sur Worksheet_Change

kinel

XLDnaute Occasionnel
Bonjour à tous
j'ai un souci sur le code suivant

sur la partie qui doit effacer automatiquement certaines cellules, si la cellule 4 est effacée il doit y avoir effacement automatique des cellules 3, 5, 6, 7, et 8
tout fonctionne bien sauf la 3 qui refuse de s'effacer

merci de votre aide
Kinel

Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean

'automatise la Majuscule sur le prénom
If Not Intersect(Target, Range("E3:E62")) Is Nothing Then
Application.EnableEvents = False
Target.Value = StrConv(Target, vbProperCase)
Application.EnableEvents = True
End If

'efface les infos si le nom est effacé
If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
If IsEmpty(Target) Then

Application.EnableEvents = False
Target.Resize(, 3).ClearContents ' <<<<<<< ici
Target.Resize(, 5).ClearContents
Target.Resize(, 6).ClearContents
Target.Resize(, 7).ClearContents
Target.Resize(, 8).ClearContents
Application.EnableEvents = True
End If

'automatise le nom en MAJUSCULE
If Not Intersect(Target, Range("D3:D62")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("D3:D62")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If

End Sub

 

kinel

XLDnaute Occasionnel
Re : problème sur Worksheet_Change

bonjour le forum

j'ai donc placé cette macro sur ma feuille et tout fonctionne bien mais je voudrai la compléter:
sur la partie 'efface les infos si le nom est effacé
je voudrai que la commande efface en même temps les cellules ("C6:AD17") de la feuille dont le nom se trouve sur la colonne 3 de la même ligne

merci de votre aide

Kinel



Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean

'automatise la Majuscule sur le prénom
If Not Intersect(Target, Range("E3:E62")) Is Nothing Then
Application.EnableEvents = False
Target.Value = StrConv(Target, vbProperCase)
Application.EnableEvents = True
End If

'efface les infos si le nom est effacé
If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
If IsEmpty(Target) Then

Application.EnableEvents = False
Target.Offset(, -1).Resize(1, 6) = ""
Application.EnableEvents = True

End If

'automatise le nom en MAJUSCULE
If Not Intersect(Target, Range("D3:D62")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("D3:D62")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 520
Messages
2 089 297
Membres
104 092
dernier inscrit
karbone57