Microsoft 365 UserForm calendrier ne pas pouvoir en sortir si pas de date sélectionnée

[Usine à gaz]

Bonjour à toutes et à tous 🙂

Je bute encore sur un code que je n'arrive pas à FAIRE.
Je voudrais "NE PAS POUVOIR SORTIR SI PAS DE DATE SELECTIONNEE"
Mon contexte :
Pour obliger à sélectionner une date de rappel, je souhaite qu'on ne puisse pas sortir si pas de date sélectionnée = seule sortie possible, la sélection d'une date.
Pour arriver au calendrier, on clique dans la colonne "L", on affecte en sélectionnant "A Rappeler" (le 1er en haut du déroulant) et le calendrier s'affiche.

J'ai tenter plusieurs code dont celui ci-dessous :

Private Sub ButtonOK_Click()
If Date = TODAY Then
'If Date = .FormulaR1C1 = "=TODAY()" Then
MsgBox ("Vous devez sélectionner une date de Rappel !")
Exit Sub
Else
ActiveCell = CalendrierDateSELECT: Unload Me
End If
End Sub

Sans succès Grrr !!! 😡
Pourriez-vous m'aider ?

En cas, je joins mon fichier test et le fichier qui fonctionne.
Un grand merci à tous,
🙂

 

[fanch55]

Salut Lionel, le code ci-dessous devrait faire l'affaire :

Private Sub ButtonOK_Click()
    If CalendrierDateSELECT <= Date Then
        MsgBox ("Vous devez sélectionner une date de Rappel !")
    Else
        ActiveCell = CalendrierDateSELECT
        Unload Me
    End If
End Sub

 

[Usine à gaz]

Bonjour fanch55 🙂
Vite fait et bien fait 😉
C'est nickel, je te remercie 🙂

 

[Usine à gaz]

Re-fanch55 🙂
Ton code est nickel mais j'avais omis une autre situation :

Ce que je voudrais :
1 - Si clic dans une cellule de la colonne "L" (Cells(ActiveCell.Row, 13)) = ton code s'éxécute et bloque si pas de date sélectionnée,
2 - Si clic dans une cellule de la colonne "O" (Cells(ActiveCell.Row, 15)) = la possibilité est laissée de ne pas sélectionner de date et le calendrier se ferne.

J'ai tenté de bidouiller et j'en suis à ce code :

Private Sub ButtonOK_Click()
    If ActiveCell = Cells(ActiveCell.Row, 13) Or ActiveCell = Cells(ActiveCell.Row, 15) Then
        If ActiveCell = Cells(ActiveCell.Row, 15) And CalendrierDateSELECT <= Date Then
            Unload Me
            Cells(ActiveCell.Row, 5).Select
            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Cells(ActiveCell.Row, 15) = ""
        End If
        If ActiveCell = Cells(ActiveCell.Row, 13) And CalendrierDateSELECT <= Date Then
            MsgBox ("Vous devez sélectionner une date de Rappel !")
        Else
            ActiveCell = CalendrierDateSELECT
            Unload Me
        End If
    End If
End Sub

Mais ça ne marche pas ol 😡
tu aurais le bon code ?
Je remets le fichier avec juste ton code ci-dessus inclus.
Voudrais-tu encore m'aider ?
UN re-Grand merci à toi...
🙂

 

[Usine à gaz]

Re 🙂
J'en suis là :

Private Sub ButtonOK_Click()
    If ActiveCell.Address = Cells(ActiveCell.Row, 15) And CalendrierDateSELECT <= Date Then
        Unload Me
        Cells(ActiveCell.Row, 5).Select
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Cells(ActiveCell.Row, 15) = ""
    End If

    If ActiveCell.Address = Cells(ActiveCell.Row, 13) Then
        If CalendrierDateSELECT <= Date Then
            MsgBox ("Vous devez sélectionner une date de Rappel !")
        Else
            ActiveCell = CalendrierDateSELECT
            Unload Me
        End If
    End If
End Sub

Mais ça veut pas fonctionner
Sniff....
🙂

 

[fanch55]

Bonjour,
Déclaration d'une variable publique de type range dans le module CroixFormulaire .

Option Explicit
...
...
Public SelCell As Range

Modification de Worksheet_SelectionChange de la feuille Répondeurs pour assigner la cellule cliquée à la variable publique .

Private Sub Worksheet_SelectionChange(ByVal R As Range)
...
Set SelCell = R
    If Not Intersect(R, Range("l6:l12")) Is Nothing And R.Count = 1 Then
...

Modification de l'initialize de l'userform fm_CalendrierCellMinMax pour neutraliser la croix de fermeture sans choix uniquement si la colonne est "L"

Private Sub UserForm_Initialize() 'place userf aux environs de la cellule
    If SelCell Is Nothing Then Set SelCell = ActiveCell
    If SelCell.Column = Columns("L").Column Then
        ' on neutralise la croix de fermeture
        hwnd = FindWindowA("Thunder" & _
               IIf(Application.Version Like "8*", "X", "D") & "Frame", _
               Me.Caption)
        SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
    End If
....
....
End Sub

 

[Usine à gaz]

Bjr fanch55 🙂
Merci à toi, ça fonctionne
🙂