Code VBA pour autoriser une entrée précise dans une cellule

Le 09/06/2010 à 16:40

Bonjour,

Je présume que je n’ai pas besoin de vous indiquer ce que permet le code ci-dessous

Mais pourriez vous m’indiquer comment le modifier afin qu’il autorise en M12 l’introduction d’une date correspondant qu’à une certaine période, par exemple du 1er janvier 2008 au 31 décembre 2010 (et je modifierais le texte de la MsgBox en conséquence) ?

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("M12")) Is Nothing Then
  With Target
    If .Value < CDate("01/10/2008") And Not IsEmpty(.Value) Then

      Dim réponse As Byte 'oui=6 non=7
      réponse = MsgBox("Ce calcul n’est pas prévu" & vbNewLine & _
      "pour une date avant le 01.10.2008." & vbNewLine & "" & vbNewLine & _
      "Voulez-vous malgré tout continuer ?", vbYesNo + vbDefaultButton2)
          Select Case réponse
            Case vbYes
            Range("H15").Select
            Case vbNo
            Range("M12").Select
            Application.EnableEvents = False
              Selection.ClearContents
            Application.EnableEvents = True
          End Select
    End If
  End With
End If

End Sub

Bonne soirée.

Le 10/06/2010 à 08:37

Bonjour,

Essaie comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("M12")) Is Nothing Then
  With Target
    If .Value < CDate("01/01/2008") Or .Value > CDate("31/12/2010") Then
    Dim réponse As Byte 'oui=6 non=7
     réponse = MsgBox("Ce calcul n’est pas prévu" & vbNewLine & _
      "pour une date avant le 01.10.2008." & vbNewLine & "" & vbNewLine & _
      "Voulez-vous malgré tout continuer ?", vbYesNo + vbDefaultButton2)
          Select Case réponse
            Case vbYes
            .Offset(3, 0).Select
            Case vbNo            
            Application.EnableEvents = False
            .ClearContents
            .Select
            Application.EnableEvents = True
          End Select
    End If
  End With
End If
End Sub

Amicalement

Le 10/06/2010 à 09:58

Salut Dan,

Merci pour ta réponse et pour ton code avec lequel j’ai fait quelques essais.

Dans le fichier ci-joint il y a une feuille en allemand (IV D) qui comporte le code que j’utilisais jusqu’à maintenant. Je n’avais jamais remarqué que si une date quelconque est inscrite en M12 et qu’on l’efface, la fenêtre de débogage s’ouvre car ça bloque sur If .Value < CDate("01/01/2008") And Not IsEmpty(.Value) Then. Ce problème se retrouve également dans d’autres essais ci-dessous. Si j’arrête la macro, je peux recommencer d’autres essais.

Sur la feuille en français (IV F), j’ai combiné mon ancien code avec ta ligne If .Value < CDate("01/01/2008") Or .Value > CDate("31/12/2010") Then. C’est ce qui donne les meilleurs résultats. Une date trop ancienne ou trop éloignée n’est pas acceptée sans autre. Le problème de la fenêtre de débogage qui s’ouvre lorsque j’efface une date est identique à l’explication ci-dessus. Dans ce cas ça bloque sur If .Value < CDate("01/01/2008") Or .Value > CDate("31/12/2010") Then.

Sur la feuille en italien (IV I), j’ai placé le nouveau code tel que tu me l’as proposé. Si une date non correcte est introduite (avant 2008 ou après 2010), que la MsgBox s’ouvre et demande « Voulez-vous vraiment continuer ? » et que je clique « Non », ça bloque sur la ligne .ClearContents. Très bizarrement, dans un tel cas, même que j’arrête le code comme je le fais quand ça bloque dans les deux premiers exemples décrits ci-dessus, la plupart des macros présentes dans mon fichier ne fonctionnent plus et je peux inscrire n’importe quelle date !?!?

J’ai alors essayé de fermer le fichier et de le rouvrir, mais ça ne change rien. Par contre si je ferme l’application Excel et que je repars à zéro, mes macros recommencent à fonctionner !?!?

Si j’inscris une date acceptée immédiatement dans cette troisième feuille puis que je l’efface, la fenêtre de débogage s’ouvre également.

As-tu une explication à tout cela ou du moins une idée pour corriger le problème ?

A te relire.

Le 10/06/2010 à 10:23

re,

Je n'ai pas ton fichier là ... mais à la vue de ce que tu expliques déplaces les instructions suivantes :

Application.EnableEvents = False

avant

Select Case réponse

et

Application.EnableEvents = True

après

End Select

Pour le blocage, ajoute le mot TARGET devant .ClearContents et .Select

Sinon je suppose que ce code se trouve bien dans la feuille concernée par la Date en M12 ??

A te relire

Le 10/06/2010 à 13:57

Salut Dan,

Désolé, mais je n'avais pas remarqué que mon fichier était trop gros et il n'est pas passé. J'ai essayé de supprimer des pages et de le zippé, mais ça ne va toujours pas. Alors j'ai essayé de passer par le site Cjoint

Oui, le code se trouve bien dans la feuille concernée.

J'ai fait les essais que tu demandes, mais ça semble ne rien changer.

Regarde quand même les feuilles "IV D" et "IV F" mentionnée dans mon avant dernier message.

A la prochaine.

Le 10/06/2010 à 19:11

Re,

Je n'arrive pas à ouvrir ton fichier. Merci de remettre le lien au format *.xls.

A te relire

Le 11/06/2010 à 07:36

Désolé !

Est-ce que ça va mieux ainsi ? Je suis au travail et des options de sécurité m'empêchent de contrôler que ce soit OK !

Bonne journée.

Le 11/06/2010 à 12:29

re,

Ok c'est bon.

Quelques questions :

  • Je vois dans ton code une feuille Berechnung Kinderzulage IV qui n'est pas dans ton fichier. Normal ou pas ?
  • Le code est appliqué à toutes feuilles IV ?

Ton souci de la fenêtre de débogague sur .clearcontents vient uniquement du fait que tu as fusionné les cellules.

A te relire

Le 11/06/2010 à 19:27

Salut Dan,

Merci pour ta réponse. Comme je l'ai indiqué, j'ai dû supprimer plusieurs feuilles et macros afin que le fichier puisse être édité sur le Forum. Comme ces passages de codes à propos de la feuille (supprimée) "Berechnung Kinderzulage IV" ne concerne que l'inscription d'un chiffre dans la cellule H15 des feuilles "IV D" et "IV F", j'aurais également pu les effacer ; ça ne change cependant rien à mes essais concernant les cellules M12.

Tu me dis que mon problème de débogage vient uniquement des cellules fusionnées. Dois-je comprendre qu'il n'y a pas d'autres solutions que de le séparer ?

A te relire.

Le 12/06/2010 à 10:25

re,

essaie comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("M12")) Is Nothing Then
Select Case Target
Case Is <> 0
  With Target
    If .Value < CDate("01/01/2008") Or .Value > CDate("31/12/2010") Then
    Dim réponse As Byte 'oui=6 non=7
    réponse = MsgBox("Ce calcul n’est pas prévu" & vbNewLine & _
      "pour une date avant le 01.10.2008 ou après le 31.12.2010." & vbNewLine & "" & vbNewLine & _
      "Voulez-vous malgré tout continuer ?", vbYesNo + vbDefaultButton2)
        Application.EnableEvents = False
        Select Case réponse
        Case vbYes
        .Offset(3, 0).Select
        Case vbNo
        .ClearContents 'ou Range("M12:Q12").clearcontents
        .Select
          End Select
          Application.EnableEvents = True
          End If
  End With
Case Else
End Select
End If
End Sub

Pour ce qui est de la cellule fusionnée, c'est mieux de l'éviter. Sans quoi tu risques toujours d'avoir des bug et incompréhension dans le code. Fais l'essai avec la cellule M12 non fusionnée.

A noter que si ce code doit s'appliquer sur les feuilles IV, il y a moyen de ne faire qu'un seul code pour les trois feuilles.

A te relire

Le 12/06/2010 à 11:57

Salut Dan,

Avec le passage .ClearContents ça bloque toujours. J'ai donc essayé selon tes informations avec le passage Range("M12:Q12").clearcontents et ça va très bien. Mon problème serait ainsi parfaitement résolu et je tiens à t'en remercier sincèrement.

Tu indiques que l'on pourrait n'utiliser qu'un seul code pour les trois feuilles. Où faudrait-il le placer, sachant qu'une autre séries de feuilles - avec d'autres macros communes à ces feuilles-là, pour l'instant également placées à triple sous chaque feuille - sont pareillement présentes dans mon fichier ?

A te relire.

Le 12/06/2010 à 12:24

Re,

Il serait placé dans Thisworkbook, comme ceci

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Left(UCase(sh.Name), 2) = "IV" Then
....
....
End If
End Sub

Donc dans le code que j'ai proposé avant, il faut :

  • supprimer la première ligne et mettre les deux premières lignes ci-avant
  • Rajouter un END IF avant le END SUB

Cela suppose que les noms des feuilles concernées commencent par --> "IV"

A bientôt

Le 12/06/2010 à 13:32

Salut Dan,

Comme j'ai un série de feuilles qui commence par IV (puis D, F et I) et une autre série de feuilles qui commence par TIV (puis D, F et I) je pourrais alors écrire une macro ainsi sous Thisworkbook ???

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

[code]If Left(UCase(sh.Name), 2) = "IV" Then
....' macro concernant les feuilles IV
....
End If
If Left(UCase(sh.Name), 2) = "TIV" Then
....' macro concernant les feuilles TIV
....
End If

End Sub[/code]

Bon après-midi.

Le 12/06/2010 à 15:13

Re,

Oui exactement mais ce serait intéressant de regrouper la partie commune du code dans une seule macro placée dans un module et qui serait appelée si la condition est rencontrée. A voir si cette partie est commune bien sûr.

Amicalement

Le 14/06/2010 à 08:52

Salut Dan,

Merci pour ces informations. Comme tu me l’as proposé, j’ai essayé de regrouper certains codes communs à plusieurs feuilles sous ThisWorkbook, mais j’ai quelques soucis.

Comme il est difficile de modifier à chaque fois mon fichier afin de la présenter au maximum en français, je te fais parvenir mon fichier réel, malheureusement passablement en allemand.

Dans le module 1, j’ai un code afin de déprotéger toutes les feuilles en une seule fois (mot de passe 738305). Ce fichier est mis à disposition des utilisateurs de manière protégée.

J’ai placé un code commun aux feuilles commençant pas IV (IV D, IV F et IV I) appelé Private Sub Workbook_SheetChange. Ca fonctionne assez bien, à part que si j’efface une date inscrite en M12, le code bloque sur Case Is <> 0 et si j’inscris un chiffre en H15, la feuille voulue (Berechnung Kinderzulage IV) est bien sélectionnée, mais le code bloque sur If Not Application.Intersect(Target, Range("M12")) Is Nothing Then. Ce deuxième problème n’existait pas lorsque j’utilisais mon ancien code - encore en place individuellement, mais désactivé - sous chaque feuille IV.

Par la suite, j’aimerais encore déplacé des codes concernant les feuilles TIV, tel que prévu dans la deuxième partie de ce code.

J’ai également essayé de placer 3 anciens codes individuels sous chaque feuille IV - relatifs à l’impression - dans ThisWorkbook. Lorsque je clique sur les boutons en place sur les 3 feuilles IV (texte en allemand pour l'impression avec ou sans couleur jaune), je reçois maintenant un message d’erreur au sujet d’un « objet ».

Peux-tu encore m'aider à résoudre ces problèmes ?

Le 14/06/2010 à 13:24

re,

En fait le souci vient de tes cellules fusionnées car si tu enlèves cette fusion, tu n'as plus d'erreur. Bon je suis tout de même arrivé à corriger le code en laissant les cellules fusionnées.

Dans le code à pb, je vois en dessous --> If Left(UCase(Sh.Name), 2) = "TIV" Then

Afin d'éviter de répeter le code deux fois suivant le nom de la feuille (IV ou TIV), est-ce que les actions demandées seront les mêmes que dans le code actuel ?

Dans ton fichier je vois plusieures anomalies :

  • Tu as des SUB Imrpimer_Avec et Imprimer_Sans qui se trouvent dans les feuilles. ELles ne doivent pas se trouver à cet endroit mais bien dans un module.
  • Private Sub Worksheet_BeforPrint() doit s'appeler --> Private Sub Worksheet_BeforEPrint()

A te relire

Edit : est-il possible d'avoir un nombre de caractères identiques aux feuilles IV. Là tu as TIV d'un coté et IV de l'autre. Exemple : on conserve TIV & plutot que IV, on aurait --> VIV ??

Le 14/06/2010 à 14:47

Salut Dan,

Merci beaucoup pour tes réponses. J’ai modifié plusieurs passages selon tes informations. Je joins aussi la version actuelle de ce travail.

Dan a écrit :

….. Bon je suis tout de même arrivé à corriger le code en laissant les cellules fusionnées.

N’as-tu pas oublié de me fournir ces corrections ? Autrement je ne comprends pas cette phrase. Et comme ça bloque toujours au même endroit ………

Dan a écrit :

Dans le code à pb, je vois en dessous --> If Left(UCase(Sh.Name), 2) = "TIV" Then

Afin d'éviter de répéter le code deux fois suivant le nom de la feuille (IV ou TIV), est-ce que les actions demandées seront les mêmes que dans le code actuel ?

Non, les actions ne sont pas tout à fait les mêmes. J’ai maintenant déplacé les codes concernant les feuilles TIV à la fin de ce code.

Dan a écrit :

Est-il possible d'avoir un nombre de caractères identiques aux feuilles IV. Là tu as TIV d'un coté et IV de l'autre. Exemple : on conserve TIV & plutôt que IV, on aurait --> VIV ??

Je ne peux pas modifier le nombre de caractères des appelations des feuilles, ces abréviations voulant dire quelque chose de bien précis et de fort utile aux utilisateurs. Mais selon mes informations ci-dessus, ça me semble aussi peu utile d'avoir le même nombre de caractères (les codes TIV et IV n’ont pratiquement rien de commun).

A te relire.

Le 14/06/2010 à 16:14

re,

Revoici ton fichier en version 3 -->

J'ai modifié le code dans Thisworkbook et aussi simplifié le code dans le module de protection de feuille.

Amicalement

Le 16/06/2010 à 16:29

Salut Dan,

Désolé pour le temps de réponse assez long, mais les essais n'étaient pas simples.

Tout semble fonctionner à merveille maintenant. Je te remercie infiniment pour ta précieuse aide. C'est vraiment super !

Avec mes bonnes salutations.

Rechercher des sujets similaires à "code vba autoriser entree precise"