Date figée : une suite un peu sioux

wilkox

XLDnaute Nouveau
Bonjour,

Voici mon petit problème.

Il concerne la date figée.

J’ai utilisée votre macro à savoir :

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A5:A200")) Is Nothing Then

If Target.Value >= "" Then Range("B" & Target.Row) = Date

End If

End Sub




Elle fonctionne nickel chrome.

Par contre j’ai un souci de protection.

En effet ce fichier Excel a pour but d’être sur un réseau et d’être protégé en partie.

En fait un commercial met son nom et la date de la saisie vient en automatique.

Par contre celle-ci ne doit pas être modifiable manuellement sinon ils ont tendance à modifier cette dernière en l’antidatant (les coquins….)

Actuellement la macro m’indique un message de débogue.

J’ai essayé de voir dans les options des protections mais sans succès

Avez-vous une solution ?

D'avance merci.

El padawan del Excel:cool:
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Re : Date figée : une suite un peu sioux

Bonjour

tu as plusieurs solutions

Tu protèges ta feuille par macro à la fermeture d'excel avec userinterfaceonly à true comme cela ta macro ne bugge pas mais les users ne peuvent intervenir sur tes cellules protégés

sinon ta macro deprotèges ta feuille ecris en B et reprotèges

autre possibilité tu fais une macro qui récupères la valeur de b avant qu'il la modifies et si il la change un petit message " tu te crois où petit bonhomme !!!" :D:D et tu re mets l'ancienne valeur

Bonne soirée
 

CB60

XLDnaute Barbatruc
Re : Date figée : une suite un peu sioux

Bonsoir
Il me semble avoir vue sur le forum une macro événementielle qui bloqué une cellule aprés la saisie d'une valeur.
Je vais chercher si je la retrouve
 

CB60

XLDnaute Barbatruc
Re : Date figée : une suite un peu sioux

re
la voici ( attention elle n'est pas de moi )
des qu'une valeur est inscrite dans la colonne 5,la cellule se met en rouge et pour enlever la protection il faut aller dans outil, protection, enlever la protection et inscrire toto.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 And Target.Count = 1 Then
If Application.CountA(Range(Cells(Target.Row, 5), Cells(Target.Row, 5))) > 0 Then
ActiveSheet.Unprotect (toto)
Range(Cells(Target.Row, 5), Cells(Target.Row, 5)).Locked = True
Range(Cells(Target.Row, 5), Cells(Target.Row, 5)).Interior.ColorIndex = 3
End If
ActiveSheet.Protect (toto)
End If
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 508
Messages
2 089 143
Membres
104 050
dernier inscrit
Pepito93100