XL 2021 Calendrier DTPiker

[Bruce68]

Bonjour à tous
J'ai excel 2024 et je n'arrive pas à installer le DTPicker .
je vous remercie de votre aide

 

[nullosse]

avec la fusion et l'api dans un if vba7 en espérant qu'avec win 7 l'api ne soit pas relevée comme erreur d'entré de la dll

Salut,
A tester , des api et un code qui fonctionne à priori à partir de windows XP et Excel 2010 (début de VBA7). Pour des versions inférieures d'Excel il faut adapter les API (VBA6) :

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Const LOGPIXELSX As Long = 88

Private Function AppDpi() As Long
    Dim hDC As LongPtr
    Dim dpi As Long
    hDC = GetDC(0)
    dpi = GetDeviceCaps(hDC, LOGPIXELSX)
    ReleaseDC 0, hDC
    If dpi <= 0 Then dpi = 96   ' fallback sécurité
    AppDpi = dpi
End Function

GetDeviceCaps renvoie le DPI logique, pas le DPI par-monitor (PMv2).

 

[patricktoulon]

re
oui @nullosse sauf que la il faut faire les déclarations vb6( en long) aussi sinon win 7 toujours whalouh
autrement dit on reviens toujours au bretelles
a savoir :que vous pouvez utilisez la methode pointstoscreenpixels avec les deux
je l'ai voulu léger et limpide et a la base c'est pour les utilisateurs 64 bits
on a tout fait @Rheeem et moi pour réduire le saucissonnage
le module userform est propre ceux qui veulent l'adapter en vb6 savent ce qu'il faut faire mais je ne modifierais pas la ressource

 

[cathodique]

Mr le prend mal par ce qu'on luimet ses erreurs sous le nez

Pas du tout. Je n'ai fait qu'une suggestion pour améliorer votre proposition.
Je n'avais aucune prétention, ni d'arrière pensée.

tu partage que quand tu crois avoir raison toi

La solution partagée n'était même pas de moi. Je n'ai rien cru.
J'ai voulu juste partager ce qui me semblait être une solution.
Car je n'ai plus eu de plantage.
Aujourd'hui, j'ai appris une bonne leçon. Je dormirai moins idiot à mon âge et je m'en réjouis.

Bonne soirée.

 

[Bruce68]

Bonsoir à tous
Merci pour toutes vos réponses, maintenant il faut que je choisisse une de vos propositions.
Encore merci et bonne soirée tous

 

[patricktoulon]

une derniere chose @cathodique
toi avec 2007 et office 2007jusuqu' à 2013, tu l'a avec le com le calendrier
tu n'a pas besoins de tout ça

 

[job75]

Pour le fun, en complément de mon post #7.

Il n'y a plus d'UserForm, les 3 ComboBox sont maintenant dans la feuille de calcul :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Shapes.Range(Array("Image 1", "ComboBox1", "ComboBox2", "ComboBox3")).Visible = False
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Then Exit Sub
Dim x, y
Cancel = True
x = Target.Offset(, 1).Left: y = Target.Offset(-1).Top
With Shapes("Image 1")
    .Left = x: .Top = y: .Visible = True
End With
With ComboBox1 'Année
    .Left = x + 3: .Top = y + 18: .Value = Year(Date): .Visible = True
    .List = [""&ROW(2025:2035)]
End With
With ComboBox2 'Mois
    .Left = x + 62: .Top = y + 18: .Value = Format(Month(Date), "00"): .Visible = True
    .List = [RIGHT(ROW(101:112),2)]
End With
With ComboBox3 'Jour
    .Left = x + 121: .Top = y + 18: ComboBox3 = "": .Visible = True
End With
End Sub

Private Sub ComboBox3_GotFocus()
Dim i%, dat As Date, jour$, a$(), n%
With ComboBox3 'Jour
    If ComboBox1.ListIndex = -1 Or ComboBox2.ListIndex = -1 Then .Clear: Exit Sub
    For i = 1 To 31
        dat = DateSerial(Val(ComboBox1), Val(ComboBox2), i)
        jour = Application.Proper(Left(Format(dat, "ddd"), 2)) & " " & Format(i, "00")
        If Month(dat) = Val(ComboBox2) Then ReDim Preserve a(n): a(n) = jour: n = n + 1
    Next
    .List = a
End With
End Sub

Private Sub ComboBox3_Change()
Dim dat$
If ComboBox1.ListIndex = -1 Or ComboBox2.ListIndex = -1 Or ComboBox3.ListIndex = -1 Then ComboBox3 = "": Exit Sub
dat = Right(ComboBox3, 2) & "/" & ComboBox2 & "/" & ComboBox1
If IsDate(dat) Then ActiveCell = CDate(dat)
End Sub

Edit : à cause de la 3ème ComboBox (jour) j'ai mis une police à chasse fixe : Courier New.

 

[job75]

Bonjour le forum,

Si l'on veut que la liste des jours soit intégralement affichée (ListRows = 31) il faut cadrer la cellule active tout en haut de la feuille :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Protect "toto", UserInterfaceOnly:=True 'protège la feuille
If Target.Row = 1 Or Target.Column > 1 Then Exit Sub
Dim x, y
Cancel = True
If Target.Row > 1 Then ActiveWindow.ScrollRow = Target.Row - 1 'cadrage en haut de la feuille
x = Target.Offset(, 1).Left: y = Target.Offset(-1).Top
With Shapes("Image 1")
    .Left = x: .Top = y: .Visible = True
End With
With ComboBox1 'Année
    .Left = x + 3: .Top = y + 18: .Value = Year(Date): .Visible = True
    .List = [""&ROW(2025:2035)]
End With
With ComboBox2 'Mois
    .Left = x + 62: .Top = y + 18: .Value = Format(Month(Date), "00"): .Visible = True
    .List = [RIGHT(ROW(101:112),2)]
End With
With ComboBox3 'Jour
    .Left = x + 121: .Top = y + 18: ComboBox3 = "": .Visible = True
End With
End Sub

A+

 

[patricktoulon]

Bonjour @job75 les formule TEXT pour remplir les listes plantent chez moi
et les jours s'arrêtent a 29
j'ai remplacé les deux formules

With ComboBox1 'Année
    .Left = x + 3: .Top = y + 18: .Value = Year(Date): .Visible = True
    .List = Evaluate("row(" & Year(Date) - 1 & ":" & Year(Date) + 11 & ")")
End With
With ComboBox2 'Mois
    .Left = x + 62: .Top = y + 18: .Value = Format(Month(Date), "00"): .Visible = True
    .List = Evaluate("ROW(1:12)")
End With

et il y a un soucis de syncro par rapport a tes conditions focus

 

[fanch55]

Salut @job75,
Testé votre dernière version :
Le jour enregistré n'est pas parfois indiqué dans la liste .
Le shape n'est pas protégé, si on le détruit par mégarde ...

 

[job75]

et les jours s'arrêtent a 29

Non mais la liste sort de la feuille.

Alors mets la propriété ListRows à 10 comme je le fais au post #21.

 

[job75]

Bon j'ai revu les codes des posts #21 et #22, merci de les retester.

Pour tenir compte de la remarque de fanch55 j'ai protégé la feuille du fichier (2).

 

[fanch55]

Bon j'ai revu les codes des posts #21 et #22, merci de les retester.

Pour tenir compte de la remarque de fanch55 j'ai protégé la feuille du fichier (2).

Test du nouveau post en #22 :
Toujours des problèmes de positionnement de date : le jour n'est pas affiché au clic droit et la date n'est validée que si on change de jour .
La feuille ne doit être protégée que quand le calendrier est affiché sinon on ne peut jamais effacer la date .
il faut donc "sauvegarder" les éléments de protection avant et les restaurer après, je vous souhaite bien du courage, je m'y suis frotté sans grande satisfaction au post #6 .

 

[job75]

Il faudra préciser dans le mode d'emploi que la date est entrée dans la cellule active uniquement quand on choisit le jour.

Si l'on veut pouvoir effacer les cellules en colonne A il suffit de les déverrouiller.