problème sur Worksheet_Change

[kinel]

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("D362")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
Application.EnableEvents = True
End If

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

End Sub

 

[Pierrot93]

Re : problème sur Worksheet_Change

Bonjour,

A tout hasard, essaye peut être ceci :

Target.Resize(, 3).Value =""

bonne journée
@+

 

[kinel]

Re : problème sur Worksheet_Change

Bonjour Pierrot93,

merci pour la proposition
j'ai bien essayé mais sans résultat
n'y aurait il pas conflit avec les autres lignes ?

Kinel

 

[Pierrot93]

Re : problème sur Worksheet_Change

Re,

n'y aurait il pas conflit avec les autres lignes ?

vraisemblablement.... A noter que "resize" redimensionne une plage, en fait "target", la cellule modifiée.... la propriété "offset" serait à priori plus adaptée.... enfin me semble t il avec les éléments fournis....

 

[kinel]

Re : problème sur Worksheet_Change

merci Pierrot93

mais même avec "offset" la 3 refuse toujours de s'effacer

 

[Pierrot93]

Re : problème sur Worksheet_Change

Re,

ah sans pouvoir reproduire le cas... difficile de t'en dire plus.... A voir si tu n'as pas de cellules fusionnées....

 

[kinel]

Re : problème sur Worksheet_Change

re

mon fichier commence à dépasser les limites du forum
je vais essayer d'envoyer une version allégée

 

[Pierrot93]

Re : problème sur Worksheet_Change

Re,

mon fichier commence à dépasser les limites du forum
je vais essayer d'envoyer une version allégée

oui, un tout petit fichier ne représentant que le problème posé....

 

[Si...]

Re : problème sur Worksheet_Change

salut

essayer

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

au lieu de

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

 

[kinel]

Re : problème sur Worksheet_Change

re

voici un fichier test

le code en question se trouve dans la feuille1

merci

Kinel

 

[mécano41]

Re : problème sur Worksheet_Change

Bonjour à tous,

Essaie ce code qui devrait remplacer tout ce que tu as indiqué plus haut, sauf erreur de ma part...et si j'ai compris : effacer une cellule en amont et quatre en aval de la cellule effacée de D3 à D62.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean
If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
If Not Intersect(Target, Range("E3:E62")) Is Nothing Then
    Target.Value = StrConv(Target, vbProperCase)
    If IsEmpty(Target) Then
        Target.Offset(0, -1).Resize(, 6).ClearContents
    End If
ElseIf Not Intersect(Target, Range("D3:D62")) Is Nothing Then
        flag = True
        Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
        Target.Value = UCase(Target.Value)
End If
Application.EnableEvents = True
End Sub

Edit : je n'ai pas encore vu ton fichier

Cordialement

 

[kinel]

Re : problème sur Worksheet_Change

bonjour à tous

Bingo Si... Si...
merSi... beaucoup, Ha ! Si...
merSi... ausSi... à Pierrot

bonne journée !

Kinel

 

[Pierrot93]

Re : problème sur Worksheet_Change

Re,
bonjour SI,

peut être aussi avec ceci :

    Application.EnableEvents = False
    Union(Cells(Target.Row, 3), Cells(Target.Row, 5).Resize(, 4)).ClearContents
    Application.EnableEvents = True

Edition : bonjour Mécano

 

[Si...]

Re : problème sur Worksheet_Change

re

dans la même idée que mécano41 (on dit bien, Pierrot93 , que l'Union...))

Private Sub Worksheet_Change(ByVal R As Range)
  If R.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  If Not Intersect(R, [E3:E62].SpecialCells(2)) Is Nothing Then
    R = Application.Proper(R)
  End If
  If Not Intersect(R, [D3:D62]) Is Nothing Then
    R.Offset(0, -1).Resize(, 6).ClearContents
  End If
  Application.EnableEvents = True
End Sub

 

[kinel]

Re : problème sur Worksheet_Change

re

la dernière version de Si est sympa
mais la validation du nom m'efface la ligne

kinel