Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

le calendrier natif de Windows sans l'ocx dans userforms pour excel 64 Vallable aussi sur vba7 32 3.6

Inscrivez vous pour télécharger ce fichier
Vue principale Historique Discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

patricktoulon

XLDnaute Barbatruc
patricktoulon a soumis une nouvelle ressource:

le calendrier natif de Windows sans l'ocx dans nos userforms - le calendrier window dans office 64 bits


En savoir plus sur cette ressource...
 
Salut @patricktoulon,
D'abord meilleurs vœux pour cette nouvelle année .
J'ai testé ta dernière version:
les couleurs ne sont pas appliquées .
La date est validée immédiatement si je clique sur un choix d'année , de mois ou de semaine.

Nota: peut-être parce que c'est dans la zone horizontale où devraient se trouver les jours ?
 
l
Bonjour @fanch55
meilleurs veux egalement et surtout la santé

1° alors oui en effet cette derniere version n'utilsant pas le mapwindowpoint pour le hitest il semblerait que le clic ailleurs que les jours puisse être responsif a tord (visiblement selon les configs )
chez moi il n'y a que les semaines et jours cliquables ca peut être pratique quand on veut le lundi de la semaine X


2° les couleurs sont annulées si tu met 1 dans orinal color

3°visiblement aussi selon les version de windows ou config l'interface est différent

patrick
 
ORC=0 mais toujours pas de couleurs .
J'ai essayé de tout mettre en rouge avant le Show pour voir, seule la barre verticale de séparation des semaines a été rougie ( MCSC_TEXT ) .



Je ne semble pas avoir le même calendrier système que toi .
 
oui visiblement si le sysmonthcal32 n'est pas le même et n'a plus les fonctions utilisables avec sendmessage
là je vois pas ce que je peux faire

c'est pénible
chez moi ca marche sur 2013 32 et 2016 64
 
Salut,
une explication cohérente pour le problème des couleurs ( I.A Microsoft Copilot ):
Sur Windows 10, SysMonthCal32 respecte encore assez bien MCM_SETCOLOR. Sur Windows 11 (nouvelle version des common controls + thèmes + mode clair/sombre), une partie des couleurs que tu forces est simplement ignorée ou sur-dessinée par le thème système, même si MCM_SETCOLOR lui-même est toujours documenté de la même manière.


1. Ce qui se passe concrètement sous Windows 11​

  • Le contrôle est thémé : SysMonthCal32 est dessiné avec les styles visuels modernes (comctl32 v6). Dans ce mode, certaines parties (titre, fond, textes) sont dessinées en tenant compte du thème Windows, et pas uniquement de tes couleurs.
  • MCM_SETCOLOR reste fonctionnel, mais pas partout : la doc indique que tu peux modifier MCSC_BACKGROUND, MCSC_TEXT, MCSC_TITLEBK, etc., mais sous thème moderne, certains éléments restent contrôlés par le thème ou par le mode clair/sombre, surtout le titre et l’arrière‑plan général.
  • Résultat : ton code fonctionne encore sur une version plus ancienne des contrôles (Windows 10) et devient partiellement ou totalement ignoré sur Windows 11, alors que l’API est la même.

2. Tentatives de contournement possibles​

a) Désactiver le thème visuel pour le contrôle​

En C/C++ on peut appeler SetWindowTheme(hWnd, L"", L"") pour désactiver le thème visuel d’un contrôle et revenir à un rendu “classique”. Dans certains cas, ça redonne le contrôle complet sur les couleurs. Sur Windows 11, ce contournement est moins fiable qu’avant, mais tu peux tenter la même approche en VBA avec des déclarations API.

Exemple (à adapter à ton module, 32/64 bits, etc.) :

VB: 
#If VBA7 Then
    Private Declare PtrSafe Function SetWindowTheme Lib "uxtheme.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal pszSubAppName As LongPtr, _
        ByVal pszSubIdList As LongPtr) As Long
#Else
    Private Declare Function SetWindowTheme Lib "uxtheme.dll" ( _
        ByVal hWnd As Long, _
        ByVal pszSubAppName As Long, _
        ByVal pszSubIdList As Long) As Long
#End If

Code: 
' Désactiver le thème visuel
SetWindowTheme DatePickeHwnd, 0, 0

' Puis seulement ensuite appliquer les couleurs
SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TITLEBK, bm.BackColor
' etc.

Si malgré ça Windows 11 continue de sur-dessiner certaines parties, tu auras la confirmation que le thème moderne a la main.


3. Ce que tu peux raisonnablement attendre​

  • Ce qui peut encore marcher:
    • Couleurs du texte des jours (MCSC_TEXT, MCSC_TRAILINGTEXT) ont plus de chances d’être prises en compte que le fond global.
  • Ce qui est souvent perdu sur Windows 11:
    • Personnalisation complète du fond, du titre, et du “chrome” du contrôle (barre de titre, bordures), surtout si le système est en thème sombre / clair dynamique.
  • Alternative si tu as besoin de contrôle total:
    • Créer ton propre calendrier en VBA (grille de Label dans un Frame, par exemple).
    • Utiliser un contrôle tiers (ActiveX ou autre) qui expose officiellement les propriétés de couleur, plutôt que de “forcer” un contrôle système de plus en plus piloté par le thème.

4. En pratique, que faire dans ton projet​

  1. Tester SetWindowTheme + ton code de couleurs sur une machine Windows 11.
  2. Identifier précisément ce qui change encore (texte des jours, fond des cases, titre).
  3. Si le résultat reste insuffisant visuellement, prévoir un “mode dégradé” sur Windows 11, où tu acceptes de respecter davantage le thème système, ou bien passer à un calendrier personnalisé en UserForm.

Sous Windows 11 Excel 2016 , je n'ai pas les couleurs. J'ai testé le SetWindowTheme, cela ne semble pas marcher. Le calendrier s'adapte aux couleurs du thème windows en cours.
Exemple avec Thème contrasté Crépuscule :


Nullosse
 
Dernière édition:
Bonne nouvelle, le SetWindowTheme donne l'attendu sur mon W11,

Il faut juste corriger les déclarations
en mettant les arguments en string
VB: 
#If VBA7 Then
    Private Declare PtrSafe Function SetWindowTheme Lib "uxtheme.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal pszSubAppName As String, _
        ByVal pszSubIdList As String) As Long
#Else
    Private Declare Function SetWindowTheme Lib "uxtheme.dll" ( _
        ByVal hWnd As Long, _
        ByVal pszSubAppName As String, _
        ByVal pszSubIdList As String) As Long
#End If
Dommage collatéral : le calendrier s'est agrandi
il faudrait adapter la taille de l'userform
Le clic ailleurs que sur les jours déclenche toujours la validation de la date
 
Comme Pat ne semble pas travailler sur W11,
j'ai modifié le code de l'initialize en déplaçant les changements de couleurs juste après la création du Calendrier
et cela fonctionne correctement maintenant ( pour la taille du calendrier) :
VB: 
Private Sub UserForm_Initialize()
    Dim Rc As RECT, H As Long, W As Long, TodayWidth As Long, PPX As Double, StyleW
    Frame2.Move 1000
    PPX = 72 / AppDpi
    StyleW = WS_CHILD Or WS_VISIBLE Or IIf(Not aft.Value = 1, MCS_NOTODAY, 0) Or IIf(WEEKC.Value = 1, 4, 0)
    Frame1.Enabled = False
    DatePickeHwnd = CreateWindowExA(0, "SysMonthCal32", vbNullString, StyleW, 0, 0, 0, 0, Frame1.[_GethWnd], 0, 0, 0)
    If ORC.Value = 0 Then
        SetWindowTheme DatePickeHwnd, 0, 0
       ' SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_BACKGROUND, RGB(180, 0, 180) 'background(attention ne colore que autour du calendrier)
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TITLEBK, bm.BackColor 'background des titres (mois année/et selection
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TITLETEXT, tm.BackColor 'couleur du texte des titres mois année
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_MONTHBK, Bj.BackColor 'backgroud des cellules jour
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TEXT, cj.BackColor 'couleur du texte des cellules jours du mois selectionné
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TRAILINGTEXT, cj2.BackColor ''couleur du texte des cellules jours en dehors du mois selectionné
    End If
    SendMessageW DatePickeHwnd, MCM_GETMINREQRECT, 0, VarPtr(Rc)
    TodayWidth = SendMessageW(DatePickeHwnd, MCM_GETMAXTODAYWIDTH, 0, 0)
    If TodayWidth > Rc.Right Then: Rc.Right = TodayWidth
    SetWindowPos DatePickeHwnd, 0, 0, 0, Rc.Right, Rc.Bottom, SWP_NOMOVE
    Frame1.Move 0, 0, Rc.Right * PPX, Rc.Bottom * PPX
    Move 0, 5000, Frame1.Width + (Width - InsideWidth), Frame1.Height + (Height - InsideHeight)
    
End Sub


 
et oui le theme grossi le calendar donc comme le calcul est fait par rapport a lui avec MCM_GETMINREQRECT dans un sendmessage
peut être bloquer le theme avant la requete rectangle
VB: 
Private Sub UserForm_Initialize()
    Dim Rc As RECT, H As Long, W As Long, TodayWidth As Long, PPX As Double, StyleW
    Frame2.Move 1000
    PPX = 72 / AppDpi
    StyleW = WS_CHILD Or WS_VISIBLE Or IIf(Not aft.Value = 1, MCS_NOTODAY, 0) Or IIf(WEEKC.Value = 1, 4, 0)
    Frame1.Enabled = False
    DatePickeHwnd = CreateWindowExA(0, "SysMonthCal32", vbNullString, StyleW, 0, 0, 0, 0, Frame1.[_GethWnd], 0, 0, 0)
    SetWindowTheme DatePickeHwnd, 0, 0
      SendMessageW DatePickeHwnd, MCM_GETMINREQRECT, 0, VarPtr(Rc)
    TodayWidth = SendMessageW(DatePickeHwnd, MCM_GETMAXTODAYWIDTH, 0, 0)
    If TodayWidth > Rc.Right Then: Rc.Right = TodayWidth
    SetWindowPos DatePickeHwnd, 0, 0, 0, Rc.Right, Rc.Bottom, SWP_NOMOVE
    Frame1.Move 0, 0, Rc.Right * PPX, Rc.Bottom * PPX
    Move 0, 5000, Frame1.Width + (Width - InsideWidth), Frame1.Height + (Height - InsideHeight)
   
    If ORC.Value = 0 Then
          'SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_BACKGROUND, RGB(180, 0, 180) 'background(attention ne colore que autour du calendrier)
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TITLEBK, bm.BackColor 'background des titres (mois année/et selection
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TITLETEXT, tm.BackColor 'couleur du texte des titres mois année
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_MONTHBK, Bj.BackColor 'backgroud des cellules jour
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TEXT, cj.BackColor 'couleur du texte des cellules jours du mois selectionné
        SendMessageW DatePickeHwnd, MCM_SETCOLOR, MCSC_TRAILINGTEXT, cj2.BackColor ''couleur du texte des cellules jours en dehors du mois selectionné
    End If
   
End Sub
 
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…