Insertion nom utilisateur Windows dans cellule

Bonjour à tous,

après plusieurs recherches infructueuses sur le net, je me tourne vers vous pour voir si c'est possible de faire ceci :

Dans mon tableau excel, j'ai sur la colonne A la date du jour, sur la colonne B je veux avoir le nom d'utilisateur et sur les autres colonnes (jusqu'à AC) j'ai plusieurs données.

Ce que je cherchai à faire c'est que dès que j'ai des données dans une cellule de la colonne C (par exemple C10) et bien le nom d'utilisateur Windows soit renseigné automatiquement dans la cellule de la colonne B(B10) et qu'il reste tout le temps, même si après c'est un autre utilisateur qui modifie le fichier.

J'ai trouvé cette solution pour insérer le nom d'utilisateur Windows mais il faut le faire manuellement et de plus dès que quelqu'un d'autre modifie les fichiers tous les noms d'utilisateurs sont changés dans la colonne B :

Mis dans un module :

Public Function NomUtilisateur()
    NomUtilisateur = Environ("Username")
End Function

Sur les cellules de la colonne B je renseigne la formule :

=NomUtilisateur()

Sinon je voulais retravailler cette macro que j'ai pour l'incrémentation de la date du jour mais à priori cela ne peut pas le faire :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Set vtarget = Intersect(Target, Columns(3))
If Not (vtarget Is Nothing) Then
    For Each varea In vtarget
        For Each vcell In varea
            If Not (IsEmpty(vcell.Value)) Then
                Range("A" & vcell.Row).Value = Now
            Else
                Range("A" & vcell.Row).ClearContents
            End If
        Next
    Next
End If
Application.EnableEvents = True
End Sub

Dans le principe c'est ce que je voudrais comme macro pour renseigner le nom d'utilisateur dans la colonne B.

J'espère avoir été clair, merci par avance.

Bonjour,

Pour ton premier problème, il n'y a pas moyen de copier en valeurs toutes les cellules de la colonne B qui sont remplies à la fermeture du fichier par exemple puis de lancer une sauvegarde automatique ?

Simple idée et surtout si les valeurs de ces cellules ne viendront pas à être modifiées !

Private Sub Workbook_BeforeClose(Cancel As Boolean)

For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
    If Range("B" & i) <> "" Then
        Range("B" & i).Copy
        Range("B" & i).PasteSpecial xlPasteValues
    End If
Next i

End Sub

A optimiser selon le fonctionnement de ton fichier !

A plus

Bonjour Braters,

merci pour cette astuce, cela très fonctionne bien.

Je n'y avais pas pensé.

J'ai juste modifié ton code vu qu'il faisait un copier/coller, ma formule n'était plus dispo sur la dernière ligne de renseigner et donc on ne pouvait plus l'étirer pour les prochaines.

Ce que j'ai fait c'est que j'ai fait un copier/coller de la formule a la fermeture du fichier, voilà le code :

Private Sub Workbook_BeforeClose(Cancel As Boolean)

For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
    If Range("B" & i) <> "" Then
        Range("B" & i).Copy
        Range("B" & i).PasteSpecial xlPasteValues
    End If
Next i

    Range("AD1").Select
    Selection.Copy
    Range("B3").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

End Sub

Par contre si quelqu'un trouve pour le faire automatiquement je suis preneur.

Bonjour,

la voici automatisée ! Elle rajoute la formule en dessous de la dernière case non vide et donc tu pourra l'étendre dès la ré-ouverture de ton ficher !

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Derlig = Range("C" & Rows.Count).End(xlUp).Row

For i = 1 To Derlig
    If Range("B" & i) <> "" Then
        Range("B" & i).Copy
        Range("B" & i).PasteSpecial xlPasteValues
    End If
Next i
    Range("B" & Derlig + 1).FormulaR1C1 = "=IF(RC[1]<>"""",NomUtilisateur(),"""")"
Me.Save

End Sub

Bonjour,

super merci cela fonctionne super bien.