Problème de macro

Bonjour,

Ci-joint, un fichier comprenant plusieurs macros principalement faites par des

personnes de ce forum.

Je l'ai ai parfois ajoutées et adaptées au fichier, donc, c'est sans doute un peu le "bazar".

Néanmoins, ça fonctionne correctement, excepté un problème.

Lorsqu'on ajoute les noms et prénoms dans les feuilles "jour 2" et "jour 3",

il y a un laps de temps fort long (trop long) lors de l'encodage.

Vous pouvez le vérifier via le fichier.

Alors, quelques précisions :

Pour dévérouiller les feuilles, écrire en minuscule le mot "test" en B2 dans une des feuilles (de jour 0 à jour 4).

il y a dans la feuille "afd div" dans les colonnes H et J, une liste qui si elle est reconnue lors de l'encodage, déclenche un message.

dans les feuilles Jour 2 et Jour 3, il y a environ 200 noms et prénoms à encoder (c'est peut-être cela qui crée ce laps de temps ??).

Mais ça me parait anormal.

Je travaille sous excel 2003.

Merci pour votre aide précieuse.

Bonne journée

Pasqi

Bonjour

A tester

Tu supprimes toutes tes macros dans les feuilles "JOUR 0" à "JOUR 4"

Tu remplaces la macro existante dans ThisWorkbook par celle-ci

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim B As Boolean

 If Target.Address(0, 0) = "B2" Then
    Call Module1.WsLock(Target.Value)
  Else
    If Left(Sh.Name, 7) = "JOUR J " Then
      With Target
        If .Count > 1 Then Exit Sub
        If .Value = Empty Then Exit Sub
        If .Row < 4 Then Exit Sub
        Application.EnableEvents = False
        Select Case .Column
          Case 4
            .Value = UCase(.Value) 'on met en majuscule"NOM" col 2
            B = verif.exe(Sh.Cells(Target.Row, 4), Sh.Cells(Target.Row, 5))
          Case 5
            .Value = Application.Proper(.Value) 'on met en mixte"Prénom"col 1
            B = verif.exe(Sh.Cells(Target.Row, 4), Sh.Cells(Target.Row, 5))
          Case 7, 8, 10, 11, 12
            .Value = UCase(.Value) 'on met en majuscule"NOM" col 2
        End Select
        If B = True Then
          Sh.Cells(Target.Row, 1) = ""
          Sh.Cells(Target.Row, 4) = ""
          Sh.Cells(Target.Row, 5) = ""
          Sh.Cells(Target.Row, 6) = ""
        End If
        Application.EnableEvents = True
      End With
    End If

 End If
End Sub

Bonjour Banzai 64,

Merci de t'être penché sur mon problème et pour ta proposition.

J'ai donc fait ce que tu m'as dit, et le problème est le suivant :

Lorsque j'encode le nom et prénom dans une des feuilles JOUR J,

nom et prénom repris dans la feuille "afd-div", en colonne H et I, (exemple : nom : A et prénom : Abc)

il ne lance pas le message box : Veuillez téléphoner au 1200" et il devrait alors supprimer les données

encodées de cette ligne .

Je te renvoie le fichier modifié par ta macro.

Encore merci pour ton aide.

Pasqi

Bonjour

A voir si cela te convient

Bonjour Banzai,

Merci pour tes propositions, dans le fichier test que tu as adapté, tout semble très bien fonctionner.

Je dois maintenant vérifier que tout fonctionne dan le fichier original.

Une chose que je ne comprends pas, c'est dans la feuille afd-div, les zones nommées avant et après, je dois copier ces formules dans mon fichier ?

Je comprends pas bien le principe.

et seconde chose, dans les feuilles jour J, quand les cellules sont remplies, elles doivent être protégées, je voudrais que les cellules protégées ne soit pas séléctionnables.

Merci mille fois.

Bien à toi

Bonjour

Pasqi a écrit :

es zones nommées avant et après, je dois copier ces formules dans mon fichier ?

Non c'est juste pour te faire voir la modification, tu peux effacer ces informations

La zone nommée est dans ta liste de zone nommées (Menu Insertion ---> Noms (avec XL 2003))

Pour la 2ème question essayes ce code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim B As Boolean

 If Target.Address(0, 0) = "B2" Then
    Call Module1.WsLock(Target.Value)
  Else
    If Left(Sh.Name, 7) = "JOUR J " Then
      With Target
        If .Count > 1 Then Exit Sub
        If .Value = Empty Then Exit Sub
        If .Row < 4 Then Exit Sub
        Application.EnableEvents = False
        Sh.Unprotect Password:="test"
        Select Case .Column
          Case 4
            .Value = UCase(.Value) 'on met en majuscule"NOM" col 2
           B = verif.exe(Sh.Cells(Target.Row, 4), Sh.Cells(Target.Row, 5))
          Case 5
            .Value = Application.Proper(.Value) 'on met en mixte"Prénom"col 1
           B = verif.exe(Sh.Cells(Target.Row, 4), Sh.Cells(Target.Row, 5))
          Case 7, 8, 10, 11, 12
            .Value = UCase(.Value) 'on met en majuscule"NOM" col 2
       End Select
        If B = True Then
          Sh.Cells(Target.Row, 1) = ""
          Sh.Cells(Target.Row, 4) = ""
          Sh.Cells(Target.Row, 5) = ""
          Sh.Cells(Target.Row, 6) = ""
        End If
        Application.EnableEvents = True
        With Sh
          .Cells.Locked = True
          .Cells.SpecialCells(xlCellTypeBlanks).Locked = False
          .Protect "test"
          .EnableSelection = xlUnlockedCells
        End With
      End With
    End If

 End If
End Sub

Bonsoir Banzai,

Encore quelques soucis.

Concernant le verrouillage des cellules, ta macro verrouille la cellule dès que l'on fait "enter", alors que je voudrais qu'elle verrouille les cellules non-vides lors de la fermeture du fichier.

Important, la cellule B2 ne doit jamais se verrouiller puisque on doit y mettre le mot de passe.

Second souci, j'ai adapté mon fichier original, mais il ne détecte pas les éléments de la liste rouge (feuille afd-div, colonne H et I)

Le nom des feuilles de mon fichier original sont pas JOUR J..., mais Evenement Jour J, j'ai adapté dans this workbook :

  If Left(Sh.Name, 7) = "JOUR J " Then

par

  If Left(Sh.Name, 7) = "Evenement JOUR J " Then

Est-ce correct ?

Qu'est-ce qui peut causer la non reconnaissance de cette liste ?

Et enfin, la zone nommée doit s'adapter à la liste, mais j'ai ajouté des noms dans la liste et cela ne s'adapte pas automatiquement...

Et les nouveaux nos encodés ne sont pas détectés.

Est-ce normal ?

Merciiiii et bon dimanche.

Bonjour

Pasqi a écrit :

elle verrouille les cellules non-vides lors de la fermeture du fichier.

Au lieu d'utiliser Workbook_BeforeClose j'ai pris Workbook_BeforeSave (c'est à dire juste avant la sauvegarde)

Mais bon si tu veux à la fermeture tu peux modifier

Pasqi a écrit :

Important, la cellule B2 ne doit jamais se verrouiller puisque on doit y mettre le mot de passe.

A vérifier

Ensuite il faut adapter la macro à la longueur du nom que tu veux tester

"Evenement Jour J ": Comporte 17 lettres donc dans la macro

If Left(Sh.Name, 17) = "Evenement JOUR J " Then

Pasqi a écrit :

Qu'est-ce qui peut causer la non reconnaissance de cette liste ?

Une erreur dans la définition du nom, corrigé maintenant

A tester

Bonjour Banzai,

Voilà, j'ai adapté à mon fichier et tout semble fonctionner correctement.

Je reviendrai vers toi si j'ai un bug qui apparaitrait.

J'ai essayé de changer le Workbook_BeforeSave par le Workbook_BeforeClose, mais il m'a renvoyer un erreur.

J'ai donc laissé le beforesave.

Encore grand merci et bonne journée.