Microsoft 365 Insérer le nom utilisateur et la date du jour selon le contenu d'une cellule

[sebastien176]

Bonjour à Tous,

Dans le fichier ci-joint, j'aimerai pourvoir inscrire automatiquement le nom utilisateur si la cellule précédente contient "OK"
Une fois que le nom utilisateur est insérer, alors la cellule ne doit plus être modifiable

Cette action doit pouvoir être répétée su la dernière ligne de chaque mois

Je vous remercie par avance de vos retours

Seb

 

[st007]

bonjour,
un mix des macro incluses au fichier.
Save_Quit()
et de celle dans la feuille
comprends ce qu'elles font et tu adaptes

 

[Phil69970]

Bonjour à tous

Je te propose ceci :

Sur modif ok

Le nom de l'utilisateur est le nom déclaré dans la session windows

*Merci de ton retour

@Phil69970

 

[AtTheOne]

Bonsoir à toutes et à tous, bonsoir @sebastien176 , bonsoir @Phil69970
Comme d'habitude , je suis un peu en retard mais je présente quand même ma solution ...
J'ai crée deux macros,

• Une pour préparer les saisies( Cellules de saisie déverrouillées, accès limité aux cellules déverrouillées, protection de la feuille par mot de passe .

LE MOT DE PASSE EST "Temporaire"

'MOT DE PASSE A MODIFIER
Public Const Mdp = "Temporaire"

Sub DéVerrouillerCellsSaisie()
  'Déverrouiller les celules de saisie en début d'année
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim CellDép As Range, Wsh As Worksheet
    Set Wsh = ThisWorkbook.Worksheets("BOB. FACTION A")
    Wsh.Unprotect Mdp 'on enlève la protection
    
    iDép = 5 'début de la zone ligne 5
    iFin = Wsh.Cells(Wsh.Rows.Count, 1).End(xlUp).Row + Wsh.Cells(Wsh.Rows.Count, 1).End(xlUp).MergeArea.Rows.Count - 1 'Fin de la zone
    '1 Les critères et les dates
    Set CellDép = Wsh.[H5]  'Les critères sont en colonne H
    Col = CellDép.Column
    'On recherche les cellules non fusionnées de la colonne H
    For i = iDép To iFin
        With Wsh.Cells(i, Col)
            If Not .MergeCells Then
                'On les déverrouille ainsi que les dates (2 colonnes à droite)
                .Locked = False
                .Offset(0, 2).Locked = False
            End If
        End With
    Next i
    
    '2 Les validations par le manager
    Set CellDép = Wsh.[B5] 'Les validations sont dans la colonne B
    Col = CellDép.Column
        'On recherche les cellules non fusionnées de la colonne B
        For i = iDép To iFin
        With Wsh.Cells(i, Col)
            If Not .MergeCells Then
            'On les déverrouille ainsi que les libellés (1 colonne à droite)
                .Locked = False
                .Offset(0, 1).MergeArea.Locked = False
            End If
        End With
    Next i
    Wsh.EnableSelection = xlUnlockedCells 'seules les cellules déverrouillés sont accessibles
    Wsh.Protect Mdp 'On remet la protection
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

• La deuxième est une modif de la macro Worksheet_Change
  (Reprise du remplissage automatique de la date sur saisie d('un critère, Ecriture du libellé de validation par le Manager et vérouillage de la zone de saisie du mois validé :

Private Sub Worksheet_Change(ByVal Target As Range)
'Lorsque qu'une modification advient ...
    
    'Cas des critères
    If Target.Count = 1 And Target.Column = 8 Then
        'S'il n'y a qu'une cellule modifiée et qu'elle est en colonne H (8)
        Application.EnableEvents = False
        'Si la cellule modifiée n'est pas vide, on met la date sinon on efface la date
        If Not IsEmpty(Target) Then Target.Offset(0, 2).Value = Date Else Target.Offset(0, 2).ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If
    
    'Cas de la validation
    If Target.Count = 1 And Target.Column = 2 Then
        'Sil n'y a qu'une cellule modifiée et qu'elle est en colonne B (2)
        On Error Resume Next
        'Facultatif Test pour vérifier qu'il s'agit bien d'une cellule de validation par le manager (Validation : OK, Commentaire : "VALIDATION DU MANAGER")
        test = Target.Validation.Formula1 = "OK" And Target.Comment.Shape.DrawingObject.Caption = "VALIDATION DU MANAGER"
        On Error GoTo 0
        If test And Target.Value = "OK" Then
            'Si la validation vaut OK
            Application.EnableEvents = False
            'Libellé dans la cellule voisine
            Target.Offset(0, 1).Value = "Vu par " & Application.UserName & " le " & Format(Date, "dd/mm/yyyy")
            Me.Unprotect Mdp 'Enlever la protection de la feuille
            Target.Offset(0, -1).MergeArea.Resize(, 10).Locked = True 'Verrouiller les cellules du mois
            Me.Protect Mdp 'remettre la protection de la feuille
            Application.EnableEvents = True
        End If
    End If
    
End Sub

Voir le fichier joint
Amicalement
Alain