Insertion calendrier dans les cellules de plusieur colonnes

Bonjour à tous,

j'aimerais que quand je clique dans une des cellules au format date d'une des colonnes reprenant des dates qu'un calendrier s'affiche.

Je suis profane (comprenez débutant d'hier) en Excel et pour moi il est très difficile de comprendre vba et autre. Cependant, je suis de bonne volonté et patient. Si cela peut se faire via fichier, ben tant mieux. Un tuto sur le net?

Merci à tous

Bonjour,

tu peux utiliser celui-ci https://www.excel-pratique.com/fr/telechargements/calendriers/saisie-date-excel-no458

et éventuellement nous poster ton fichier (même simplifié) en, indiquant quelles cases sont concernées par l'appel du calendrier de façon à t'aider à résoudre cela

Merci Steelson. Cela fonctionne. Je n'ai qu'une remarque: pourquoi ne se met-il pas à jour avec l'horloge du système. Cela m'aiderait beaucoup.

Sinon, voici comment j'ai procédé. (Je précise que toutes ces lignes de code sont du charabia pour moi). J'ai téléchargé ton fichier puis exporté le fichier .bas (après de nombreux essais) pour ensuite l'importer dans mon fichier. Après avoir lu longuement le post original, j'ai édité les lignes de code qui s'affiche en cliquant sur feuille 1de mon classeur dans VBE et qui définisse la cellule choisie. Comme suggéré par un participant, j'ai remplacé "D5" par "DATE" et créé un nom reprenant toutes les cellules date.

Deux clics sur la cellule et c'est OK.

Merci infiniment pour ton aide et je clique déjà sur le petit V

MCGS a écrit :

Je n'ai qu'une remarque: pourquoi ne se met-il pas à jour avec l'horloge du système. Cela m'aiderait beaucoup.

il me semble que si quand même si la zone est vierge, sinon il reprend la valeur existante

C'est bien le cas

Effectivement, autant pour moi. J'ai encore une requête se rapportant à la couleur du jour. Ne saurait-on pas la mettre en gras de façon à la rendre plus visible. J'ai un problème de couleur avec mes vieux yeux. :-). Sinon, encore merci. Mon fichier avance bien.

Bonne soirée.

En gras personnellement je ne vois pas la différence, mais tu peux faire ceci :

Sub affichercalendrier(Optional quand As Date = -1)
Dim Sh As Object, posx%, posy%, i%, j%, tableau() As String
Dim jour As Long, mois As Integer, annee As Integer, moisplus As Long, moismoins As Long

    If MSjour Is Nothing Then Set MSjour = Selection

    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then Sh.Delete
    Next

    posx = MSjour.Offset(0, 1).Left + 2: posy = MSjour.Top + 2
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
        posx, posy, 208, 144)
        .Name = prefixe
        .Visible = True
        .Fill.ForeColor.RGB = RGB(192, 192, 240)
    End With

    If quand = -1 Then quand = IIf(MSjour = "", Date, MSjour)
    quand = DateSerial(Year(quand), Month(quand), 1)
    quand = quand - Weekday(quand, vbMonday) + 1
    mois = Month(quand + 7)
    annee = Year(quand + 7)
    moismoins = DateSerial(annee, mois - 1, 1)
    moisplus = DateSerial(annee, mois + 1, 1)

    dessiner posx + 6 + 1, posy + 6, 28 - 2, 16, "_J", "J", RGB(240, 0, 240), RGB(240, 240, 240), "'affichercalendrier(" & CLng(Date) & ")'", False
    dessiner posx + 6 + 1 + 28, posy + 6, 28 - 2, 16, "_Moins", "<<", RGB(0, 0, 0), RGB(192, 192, 192), "'affichercalendrier(" & moismoins & ")'", False
    dessiner posx + 6 + 1 + 28 * 2, posy + 6, 28 * 3 - 2, 16, "_Mois", Format(DateSerial(annee, mois, 1), "mmm-yyyy"), RGB(240, 0, 240), RGB(240, 240, 240), "'MsgBox ""Mike Steelson""'", True
    dessiner posx + 6 + 1 + 28 * 5, posy + 6, 28 - 2, 16, "_Plus", ">>", RGB(0, 0, 0), RGB(192, 192, 192), "'affichercalendrier(" & moisplus & ")'", False
    dessiner posx + 6 + 1 + 28 * 6, posy + 6, 28 - 2, 16, "_X", "X", RGB(240, 0, 0), RGB(240, 240, 240), "'fermercalendrier'", False
    For j = 1 To 7
        dessiner posx + 6 + 28 * (j - 1), posy + 10 + 16, 28, 16, "_J" & j, Format(j + 1, "ddd") & j, RGB(128, 128, 128), RGB(192, 192, 240), "", False
        For i = 1 To 6
            jour = quand + j + 7 * i - 8
            dessiner posx + 6 + 28 * (j - 1), posy + 10 + 16 * (i + 1), 28, 16, _
                CStr(jour), _
                Day(jour), _
                IIf(EstJourFerie(jour), RGB(240, 0, 0), IIf(jour = Date, RGB(240, 240, 240), IIf(Weekday(jour, vbMonday) > 5, RGB(0, 0, 240), RGB(0, 0, 0)))), _
                IIf(jour = Date, RGB(0, 0, 240), IIf(Month(jour) = mois, RGB(240, 240, 240), RGB(192, 192, 192))), _
                "'ChoixDate(" & jour & ")'", _
                IIf(jour = Date, True, False)
        Next
    Next

    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then
            i = i + 1
            ReDim Preserve tableau(1 To i)
            tableau(i) = Sh.Name
        End If
    Next
    If i = 0 Then Exit Sub
    Set Sh = ActiveSheet.Shapes.Range(tableau).Group
    Sh.Name = prefixe & "_Groupe"

End Sub

et

Sub dessiner(x%, y%, l%, h%, nom$, texte$, police As Long, fond As Long, action$, gras As Boolean, Optional ligne = True)
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, x, y, l, h)
        .Name = prefixe & nom
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .TextFrame.Characters.Text = texte
        .TextFrame.Characters.Font.Size = 9
        .Fill.ForeColor.RGB = fond
        .TextFrame.Characters.Font.Color = police
        .OnAction = action
        .Line.Visible = ligne
        .TextFrame.Characters.Font.Bold = gras
    End With
End Sub

Merci Steelson. C'est tout simplement parfait!

Bonjour Steelson,

Je reviens vers vous car j'ai un petit soucis avec le calendrier quand je veux protéger ma feuille. La fenêtre de débogage s'affiche. Y-a-t-il moyen d'éviter cela.

Merci.

en haut du module

Option Explicit
Const prefixe = "MSCalend"

Dim MSjour As Range
' mike steelson

Sub affichercalendrier(Optional quand As Date = -1)
ActiveSheet.Unprotect

' couleurs
Dim fondJour, fond, police, policeSemaine, policeWE, policeFerie, fondAujourdhui, policeFermeture, fondAutreMois

' .... je ne mets pas la suite

et plus loin dans le module

Sub ChoixDate(quand)
On Error Resume Next ' cas où le calendrier est resté actif à la fermeture
Dim Sh As Object
    MSjour.Value = quand
    Set MSjour = Nothing
    fermercalendrier
End Sub

Sub fermercalendrier()
Dim Sh As Object
    Set MSjour = Nothing
    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then Sh.Delete
    Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

adapte si besoin le niveau de protection (ici sans mot d passe)

Merci Steelson!

Cordialement

Bonjour Steelson,

je ne m'en sors pas, il me reste juste ce problème à résoudre et j'ai fini. Pouvez-vous m'aider. j'aimerais protéger la feuille par mot de passe mais cela rend les cellules (déverrouillées) inactives pour le calendrier (Il me demande le mot de passe pour la cellule- proteger sans mot de passe ça fonctionne). Je ne trouve pas le code à mettre (l'option que je peux changer) pour proteger la feuille avec mots de passe.

J'ai essayer ça mais ne fonctionne pas

ActiveSheet.EnableSelection = xlUnlockedCells

Merci.

Cordialement.

https://forum.excel-pratique.com/excel/proteger-une-feuille-par-mot-de-passe-t28459.html

Sub proteger()
Feuil1.Protect Password:="Toto"
End Sub

Sub déproteger()
Feuil1.Unprotect Password:="Toto"
End Sub

Je n'y arrive pas. Mes cellules calendrier sont déverrouillées, les autres non. J'aimerai que la feuille soit protégée par mots de passe. Avec les deux lignes de code, il me demande le mot de passe pour utiliser les cellules calendrier une fois mais la feuille se déverrouille également (avec le bon mot de passe dans les deux lignes). J'ai trouve des truc sur le net mais sans succès. Merci

Sub fermercalendrier()
Dim Sh As Object
    Set MSjour = Nothing
    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then Sh.Delete
    Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub proteger()
Feuil1.Protect Password:="Toto"
End Sub

Sub déproteger()
Feuil1.Unprotect Password:="Toto"
End Sub

peux-tu me passer ton fichier (en mp si tu le souhaites) ? sinon je regarderai demain en me faisant un fichier-test

Je préfère que tu fasses un test mais vraiment quand tu as le temps. Trop de données sensibles ....mais je vais quand m^me essayer de vider... je regarde.

Dans Feuil1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("DATECALENDAR")) Is Nothing Then Exit Sub
    Cancel = True
    affichercalendrier
End Sub

C'est tout !

Dans le module calendrier

Sub affichercalendrier(Optional quand As Date = -1)
ActiveSheet.Unprotect Password:="Toto"
' ................

et

Sub fermercalendrier()
Dim Sh As Object
    Set MSjour = Nothing
    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then Sh.Delete
    Next
ActiveSheet.Protect Password:="Toto", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Merci Steelson. Parfait!

Je tiens vraiment à te remercie pour le partage de tes connaissances. Cela va m'éviter des milliers de clics et de frappes. Je suis vraiment très heureux de ce partage. Je sais que mes demandes fessaient un peu "pompeur" mais je n'y arrivais pas car pas de connaissance. J'ai pas mal ramé avec les formules, les graphiques, toutes mes recherches car je suis profane. Sans toi et les autres membre du forum, je n'y serais pas arrivé. Merci à toi, merci à tous.

Excel, quel programme formidable!

Encore merci!

Bonjour,

Je reviens vers vous car je constate un bug. Lorsque je me sers du filtre du tableau, et que j'effectue une correction dans une cellule "calendrier", la fonction filtre se bloque. A vrai dire, après avoir hôté la protection de la feuille, je constate que la fonction filtre n'est plus cocher pour son utilisation.

Peut-être pas un bug mais une constatation: lorsque la feuille est déverrouillée et que j'utilise une cellule calendrier, la feuille se verrouille. Personnellement, cela me gêne pas mais cela reste une information.

Merci.

MCGS a écrit :

lorsque la feuille est déverrouillée et que j'utilise une cellule calendrier, la feuille se verrouille.

C'était ta demande...