valeur automatique d'une cellule et création d'un MDP

[dss]

Bonjour le forum,

1) Je cherche à attribuer automatiquement en colonne F sur chaque ligne d'un tableau la date d'enregistrement du jour : aucune saisie manuelle ne sera possible sur la cellule concernée.

2) Seul l'accès à la cellule concernée par MOT DE PASSE afin d'annuler la saisie doit être possible.

Comment faire ?

Merci de votre aide

Cordialement

dss

 

[Cousinhub]

Re : valeur automatique d'une cellule et création d'un MDP

Bonjour, dans l'évènement de ton classeur :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
With Sheets("feuil1")
If .[f65000].End(xlUp).Value = Date Then Exit Sub
.Unprotect "mdp"
.[f65000].End(xlUp).Offset(1, 0) = Date
.Protect Password:="mdp", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With
End Sub

La date de la sauvegarde sera donc la dernière cellule de ta colonne F.
regarde le fichier joint, et reviens si tu as un problème.
Bon week-end

 

[dss]

Re : valeur automatique d'une cellule et création d'un MDP

Bonjour le forum,

Merci à toi bhbh de te pencher sur mon pb : en fait, je n'ai pas dû être assez explicite pour définir mes besoins.

Aussi, Je joins un petit fichier en complément de mes propos ci-dessous.Regarde la pièce jointe date auto.zip

Dans mon tableau qui va de colonne Aà C
Je rentre des infos en colonne C et je veux que les données de chaque cellule en colonne B (colonne date d'enregistrement) soit égale à celle de la date du jour de la saisie en colonne C : ce principe vaut pour chaque ligne.
Une fois remplie, la cellule de la ligne concernée en colonne B ne pourra être modifiée que par mot de passe mais s'il y a des changements en colonne C sur la même ligne.


Merci d'avance

Cordialement

dss

 

[Cousinhub]

Re : valeur automatique d'une cellule et création d'un MDP

Bonsoir,
regarde un peu le fichier joint, et dis-moi si cela te convient
PS: A partir de demain, absent 2 mois pour raison professionnelle, mais je ne doute pas qu'un intervenant puisse répondre à une question éventuelle.

Dans le code évènement de feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Rg As Range
Set Rg = Intersect(Target, Columns("C:C"))
If Not Rg Is Nothing And Target.Count = 1 Then
With ActiveSheet
If Target.Offset(0, -1) = "" Then
.Unprotect "mdp"
.Cells.Locked = False
.Columns("B:B").Locked = True
Target.Offset(0, -1) = Date
Else
Dim mdP As String, t As Byte
mdP = "mdp"
t = 0
Do
t = t + 1
anS = Application.InputBox("Il faut le mot de passe pour modifier", _
"Tentative " & t, , , , , , 1 + 2)
If anS = mdP Then
MsgBox "vous pouvez modifier"
Target.Offset(0, -1).Select
.Unprotect "mdp"
Exit Sub
End If
Loop While t < 3
End If
.Protect Password:="mdp", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Rg As Range
Set Rg = Intersect(Target, Columns("B:B"))
If Not Rg Is Nothing And Target.Count = 1 Then

ActiveSheet.Protect Password:="mdp", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End If
End Sub


fichier joint :