bonjour à tous
j'utilise les commandes suivantes qui fonctionnent très bien
le soucis est que la feuille est protégée, je lève la protection pour appliquer les commandes puis, en principe la protection devrait être replacée automatiquement ce qui n'est pas le cas
j'ai bien essayé de déplacer la commande ActiveSheet.Protect mais sans grand succès
pouvez vous m'aider sur ce problème ?
merci
Kinel
Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C4:M33")) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect
Range("O" & Target.Row).Value = Date
ActiveSheet.Protect
Application.EnableEvents = True
End If
ActiveSheet.Unprotect
Rows.AutoFit
If Not Intersect(Target, Range("c4:c33")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("c4:c33")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
flag = True
Target.Value = UCase(Target.Value)
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("D433")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Target.Value = StrConv(Target, vbProperCase)
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Target.Column <> 3 Or Target.Count > 1 Or (Target.Row < 4 Or Target.Row > 33) Then Exit Sub
If IsEmpty(Target) Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Target.Resize(, 4).ClearContents
Target.Resize(, 5).ClearContents
Target.Resize(, 6).ClearContents
Target.Resize(, 7).ClearContents
Target.Resize(, 8).ClearContents
Target.Resize(, 9).ClearContents
Target.Resize(, 10).ClearContents
Target.Resize(, 11).ClearContents
ActiveSheet.Protect
Application.EnableEvents = True
End If
ActiveSheet.Protect
End Sub
j'utilise les commandes suivantes qui fonctionnent très bien
le soucis est que la feuille est protégée, je lève la protection pour appliquer les commandes puis, en principe la protection devrait être replacée automatiquement ce qui n'est pas le cas
j'ai bien essayé de déplacer la commande ActiveSheet.Protect mais sans grand succès
pouvez vous m'aider sur ce problème ?
merci
Kinel
Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C4:M33")) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect
Range("O" & Target.Row).Value = Date
ActiveSheet.Protect
Application.EnableEvents = True
End If
ActiveSheet.Unprotect
Rows.AutoFit
If Not Intersect(Target, Range("c4:c33")) Is Nothing Then
Application.EnableEvents = False
flag = True
Target.Value = Evaluate("PROPER(""" + Target.Value + """)")
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("c4:c33")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
flag = True
Target.Value = UCase(Target.Value)
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("D433")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Target.Value = StrConv(Target, vbProperCase)
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Target.Column <> 3 Or Target.Count > 1 Or (Target.Row < 4 Or Target.Row > 33) Then Exit Sub
If IsEmpty(Target) Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Target.Resize(, 4).ClearContents
Target.Resize(, 5).ClearContents
Target.Resize(, 6).ClearContents
Target.Resize(, 7).ClearContents
Target.Resize(, 8).ClearContents
Target.Resize(, 9).ClearContents
Target.Resize(, 10).ClearContents
Target.Resize(, 11).ClearContents
ActiveSheet.Protect
Application.EnableEvents = True
End If
ActiveSheet.Protect
End Sub