Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules

sebastien176 · 12 Juin 2023

Bonjour à tous,

Dans le fichier ci-joint, j'aimerais pourvoir mettre :
1 - la date du jour dans la colonne J quand je renseigne la colonne H
2 - Pareil pour la colonne N quand je renseigne la colonne L

J'ai déjà ce code sur la feuille "cariste" mais n'arrive pas à trouver le moyen de faire la même chose pour les colonne L et N:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 8 Then Exit Sub
If Target.Row = 1 Then Exit Sub
Target.Offset(0, 2) = Date
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value
Application.ScreenUpdating = False
ActiveSheet.Unprotect
If Not Intersect(Target, Columns("h")) Is Nothing Then
On Error Resume Next
For w = 1 To Range("h" & Rows.Count).End(xlUp).Row
If Range("h" & w) = "" Then
Range("h" & w).Locked = False
Range("j" & w).Locked = False
Else
Range("h" & w).Locked = True
Range("j" & w).Locked = True
End If
Next
End If
ActiveSheet.Protect
End Sub

Je vous remercie par avance de votre aide

Seb

job75 · 13 Juin 2023

Bonjour sebastien176, le forum,

Le plus simple est de compléter la macro comme ceci :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Or CStr(r) <> "" And r.Interior.Color = vbRed Then r(1, 3) = Date
Next
End Sub

A+

job75 · 12 Juin 2023

Bonjour sebastien176,

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Then r(1, 3) = Date
Next
End Sub

Je ne m'occupe pas de la protection éventuelle.

A+

sebastien176 · 13 Juin 2023

job75 à dit:
Bonjour sebastien176,

VB:

Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange) If r Is Nothing Then Exit Sub For Each r In r If IsNumeric(CStr(r)) Then r(1, 3) = Date Next End Sub

Je ne m'occupe pas de la protection éventuelle.

A+

Bonjour Job75,

Je te remercie pour ton retour sur ma demande

je viens de vérifier ton code

Il marche bien mais quelques éléments me manque :

- Sur la dernière ligne de chaque mois (ligne rouge) je dois remplir en texte par la liste déroulante des colonnes H et L . Du coup il n'y à pas de report de date dans les colonnes J et N pour ces lignes.

As-tu une solutions à ces questions ?

merci d'avance

Bonne journée

Seb

job75 · 13 Juin 2023

Bonjour sebastien176, le forum,

Le plus simple est de compléter la macro comme ceci :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Or CStr(r) <> "" And r.Interior.Color = vbRed Then r(1, 3) = Date
Next
End Sub

A+

sebastien176 · 13 Juin 2023

job75 à dit:
Bonjour sebastien176, le forum,

Le plus simple est de compléter la macro comme ceci :

VB:

Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange) If r Is Nothing Then Exit Sub For Each r In r If IsNumeric(CStr(r)) Or CStr(r) <> "" And r.Interior.Color = vbRed Then r(1, 3) = Date Next End Sub

A+

Super,

Merci encore pour ton aide Job75
Cela marche très bien

Bonne journée

Seb

Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules

sebastien176

XLDnaute Junior

Pièces jointes

job75

job75

XLDnaute Barbatruc

sebastien176

XLDnaute Junior

job75

XLDnaute Barbatruc

sebastien176

XLDnaute Junior

Discussions similaires