Code VBA Empêcher modification liste de cellule selon une date

Le 07/05/2023 à 12:02

Bonjour,

Voila , dans un fichier partagé, je gère un planning de réservation de cours dans lequel son inscrit une liste de prénom , exemple :
- La date d'aujourd'hui : "B1"
- Les différentes dates de cours : "B3", "C3", "D3", "E3", etc ....
- La liste des participants pour chaque cours en "(B4;B9)", "(C4;C9)", "(D4;D9)", etc...

Ce que je souhaite réaliser, c'est que lorsque la date d'aujourd'hui est :
< à la date du cours : Possibilité de modifier ou supprimer la valeur dans la "liste de prénom participant" en dessous de la date du cours correspondant

>= à la date du cours : Impossibilité de modifier ou supprimer la valeur dans la "liste de prénom participant" en dessous de la date du cours correspondant

En m'inspirant d'un code VBA trouvé sur internet pour verrouiller les cellules selon valeur, j'ai 'essayé d'inscrire le code suivant dans la partie "VBA Project" correspondant à la feuille de mon planning :

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("B1") < Range("B3") Then
Range("B4:B9").Locked = False
ElseIf Range("B1") >= Range("B3") Then
Range("B4:B9").Locked = True

If Range("B1") < Range("C3") Then
Range("C3:C9").Locked = False
ElseIf Range("B1") >= Range("C3") Then
Range("C3:C9").Locked = True

If Range("B1") < Range("C3") Then
Range("C3:C9").Locked = False
ElseIf Range("B1") >= Range("C3") Then
Range("C3:C9").Locked = True
End If
End Sub




Mais je n'arrive pas à faire fonctionner ce code dans mon fichier et je ne sais pas pourquoi ?!
Et j'aimerai aussi pouvoir rajouter des nouvelles dates de cours en dessous de mon planning et continuer à bloquer les cellules au fur et à mesure que la date "d'aujourd'hui" en "B1" change

Avez vous une solution pour corriger et améliorer en répétition automatique ce code ?

Merci d'avance pour votre aide

image

Edit Modo : Mis codes entre balises

Le 07/05/2023 à 16:54

Bonjour Flopie71,

Je te propose un autre code ci-dessous, réalisé pour la partie supérieure de tes données (Rangée B3 à E9).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsDate(Cells(3, Target.Column)) And (Target.Row > 3 And Target.Row < 10) Then
    Diff = Cells(3, Target.Column) - Range("$B$1")
    Select Case Diff
    'Interdiction de modifier les choix inscrits
    Case Is >= 0.01
    Cells(2, Target.Column).Select
    'Modification possible des entrées
    Case Is < 0
    'Nothing
    End Select
    End If
End Sub

A copier et adapter pour la partie inférieure dans le même évènement SelectionChange.

Le 07/05/2023 à 20:52

Bonsoir X Cellus,

Je vous remercie. votre code semble fonctionner (pour une première partie de tableau) !

N'ayant pas du tout la maitrise du langage VBA , j'ai qu'en même pu retranscrire votre code sur mon tableau avec une série de dates et de prénom correspondant (sans avoir besoin d'utiliser les fonctions "verrouillage / déverrouillage" des cellules), c'est super !

J'ai réussi à adapter votre code selon mon besoin comme ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsDate(Cells(159, Target.Column)) And (Target.Row > 159 And Target.Row < 166) Then
    S19 = Range("$H$1") - Cells(159, Target.Column)
    Select Case S19
    'Interdiction de modifier les choix inscrits
    Case Is >= 0
    Cells(159, Target.Column).Select
    'Modification possible des entrées
    Case Is < 0
    'Nothing
    End Select
    End If
End Sub

Par contre comme je gère dans mon tableau les inscriptions en semaine hebdomadaire (les une à la suite et en dessous des autre).
Comment je peut répéter l'opération de votre code pour chaque semaine de mon tableau ?

Voici exactement une petite capture d'une partie de mon vrai tableau planning, avec H1 = "aujourd'hui()" pour exemple :

image

Merci encore pour votre aide

Le 08/05/2023 à 10:03

Rebonjour,

J'ai recopié et recollé autant de fois que j'ai de semaine le code de "X Cellius"

Malgré la longueur du total, cela semblait fonctionner sous "Microsoft Excel" et correspondre à mon besoin.

Mais dès que j'ai voulu tester de modifier mon fichier sous "Excel Online" (sous un navigateur) le code mis en place n'a pas fonctionné. Pire ce dernier a été supprimé de VBA lorsque j'ai voulu sauvegarder en écrasant mon fichier excel.

Malgré que le code de X Cellius, soit correcte Sous Microsoft Excel, je pense que ce code n'est pas le mieux pour fonctionner sous Excel Online.

Est ce qu'il est possible de faire un code similaire mais en utilisant la fonction "verrouillage/déverrouillage" des cellules ?
Un peu dans ce genre :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsDate(Cells(11, Target.Column)) And (Target.Row > 11 And Target.Row < 18) Then
    Diff = Range("$H$1") - Cells(11, Target.Column)
    Select Case Diff
    'Interdiction de modifier les choix inscrits
    Case Is >= 0
    Cells(12, Target.Column).Locked=True
    Cells(13, Target.Column).Locked=True
    Cells(14, Target.Column).Locked=True
    Cells(15, Target.Column).Locked=True
    Cells(16, Target.Column).Locked=True
    Cells(17, Target.Column).Locked=True
    'Modification possible des entrées
    Case Is < 0
    Cells(12, Target.Column).Locked=False
    Cells(13, Target.Column).Locked=False
    Cells(14, Target.Column).Locked=False
    Cells(15, Target.Column).Locked=False
    Cells(16, Target.Column).Locked=False
    Cells(17, Target.Column).Locked=False
    'Nothing
    End Select
    End If
End Sub

Et est ce qu'il est possible de le rendre plus compact et répétitif ?

Une autre question plus général : Est ce qu'il est possible de mettre en place un code VBA dans un fichier excel qui fonctionne sur différentes applications qui peuvent ouvrir et modifier ces fichiers excel :
- Sous Excel Online ?
- Sous OpenOffice ?
- Sous Google Doc ?
etc ....

Le 08/05/2023 à 12:00

Bonjour Flopie71,

Je joins la nouvelle version du code pour s'adapter au tableau présenté.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Zone planning D à H et recherche de la ligne de la date inférieure proche
If Target.Row > 32 And (Target.Column > 3 And Target.Column < 9) Then
NumWeek = Int((Target.Row - 26) / 7)
LigDate = 26 + NumWeek * 7
Else: Exit Sub
End If
'Contrôle des valeurs entrées selon date ciblée
    If IsDate(Cells(LigDate, Target.Column)) And (Target.Row > 32 And Target.Row < 400) Then
    Diff = Cells(LigDate, Target.Column) - Range("$H$1")
    Select Case Diff
    'Interdiction de modifier les choix inscrits
    Case Is >= 0.01
    Cells(LigDate, Target.Column).Select
    'Modification possible des entrées
    Case Is < 0
    'Nothing
    End Select
    End If
End Sub

Celui-ci est basé au vu de l'image sur une première date en ligne 33 pour la semaine 1. Ce qui amène à une date à la ligne 159 en semaine 19, etc...

Le 08/05/2023 à 12:07

Suite,

Et est ce qu'il est possible de le rendre plus compact et répétitif ?

Il est maintenant compact pour s'adapter à l'image postée.

Note que Excel Online n'accepte pas les macros. Cela pour la sécurité. Et tu ne pourras donc de ce fait avoir de macros.

Par contre tu pourras mettre en OnLine le résultat sous un fichier de type xlsx.

Les modifications étant toujours réalisées hors ligne sur le fichier de type xlsm.

Le 08/05/2023 à 13:15

Rebonjour,

Je vous remercie "X Cellius" pour ce complément d'information

C'est ce que je craignais!
Concernant "excel online" c'est bien ce que j'ai compris ultérieurement : pas compatible avec les fonctions macro VBA !

Je ne sais pas comment je vais contourner cette incompatibilité ???

Pour explication :
Comme il n'est pas possible de mettre mon fichier planning excel dans un système Onedrive accessible par tous les membres de mon activité.
Celui-ci est actuellement directement partagé dans un système similaire type "BOX".

Mais à partir de ce système BOX, tous les membre peuvent modifier notre fichier planning partagé:
- soit à partir de microsoft excel (si ils ont l'application sur leur PC )
-soit à partir d'excel online (pas besoin d'application et possible de se connecter sur smartphone)
-soit à partir d'applications alternative gratuit type : open office, google doc, etc...

Dans ces conditions, il m'est difficile de restreinte l'utilisation de mon fichier uniquement à un usage sur Microsoft Excel.

Merci qu'en même pour votre aide

Le 08/05/2023 à 14:49

A nouveau,

Je peux te fournir une version sans VBA pour ta demande. A partir d'une formule conditionnelle.

Testée dans l'exemple ci-dessous sur une date en ligne B33 et une date du jour en H1. La liste des prénoms étant de M1 à M6.

image

Il faudra évidemment modifier la formule pour les autres dates présentes dans le tableau.

Lorsque la date est inférieure à celle du jour, la liste déroulante sera active sur tous les prénoms. Sinon elle sera restreinte au prénom inscrit.

Si cette solution te convient, merci de passer le sujet en résolu.

Rechercher des sujets similaires à "code vba empecher modification liste date"