Problème de date

Help Denis
Sur l'exemple que tu as mis en ci-joint le 13 mai dernier:

Pour aider la saisie, je te suggère d'utiliser un formulaire ressemblant à
ceci : http://cjoint.com/?DEnbIe07v2x
Tu n'as pas besoin d'ajouter une bibliothèque supplémentaire.

Dès lors que je descends dans la feuille, le calendrier apparait plus bas et n'est plus accessible.
Place toi en ligne 100 par exemple et fais un double clic dans la feuille.

Regarde ce qui se passe.

JP

Place toi en ligne 100 par exemple et fais un double clic dans la feuille.

Cher contributeur, surtout ne pas effectuer le test proposé ni sur la ligne
100, ni sur les suivantes ; cela a "méchamment" planté mon ordinateur.
La vraie question est pourquoi ?
Michel





"JP" a écrit dans le message de groupe de discussion :
06ace090-cbf4-4f03-9a30-c5d445011894@googlegroups.com...

Help Denis
Sur l'exemple que tu as mis en ci-joint le 13 mai dernier:

Pour aider la saisie, je te suggère d'utiliser un formulaire ressemblant à
ceci : http://cjoint.com/?DEnbIe07v2x
Tu n'as pas besoin d'ajouter une bibliothèque supplémentaire.

Dès lors que je descends dans la feuille, le calendrier apparait plus bas et
n'est plus accessible.
Place toi en ligne 100 par exemple et fais un double clic dans la feuille.

Regarde ce qui se passe.

JP

Bonjour Péhemme,

Tu peux te sortir du plantage en appuyant CTL+ALT+Attn.
Ainsi on peut voir le top de l'useform. Le calendrier est bien ouvert mais en dessous des coordonnées de l'écran.

JP

Bonjour,

Tu as un fichier exemple super pour t'aider à positionner un formulaire où
tu veux dans la feuille.
Selon ton application, tu devrais possiblement l'adapter et joindre les 2
codes des formulaires.
Je ne veux pas t'enlever tout le plaisir d'écrire du code... ;-)

http://cjoint.com/?DErmJalSwRt

Une version améliorée jumelant le calendrier et le positionnement du
formulaire...dans le même formulaire!

http://cjoint.com/?DErnQEl1JqB

Tu es redoutable!
J'apprécie beaucoup ton coté pédagogique mais cette fois-ci je sèch e.

Ce qui est vrai c'est que le nouvel exemple fonctionne on ne peut mieux.

Donne moi une piste pour que je puisse voir les noms définis MichDLeft et MichDtop.
Même en mettant le thisworbook en commentaire, ils restent invisibles.

JP

| voir les noms définis MichDLeft et MichDtop

Quand le fichier ouvert copie cette macro dans un module et tu l'exécutes.
'-----------------------------------
Sub test()
MsgBox [MichDLeft] & ", " & [MichDtop]
End Sub
'-----------------------------------

Attention, c'est 2 noms représentent le coin supérieur gauche du moniteur.
Certains lorsqu'ils acquièrent un nouveau moniteur, joue avec les paramètres
de l'écran avec une série de boutons quelque part sur le moniteur...
Habituellement, le coin supérieur devrait être à Left = 0 , Top = 0 , chez
moi ces valeurs sont à left -5 , Top = -6 (volontairement et la raison,
c'est ultra-secret) , en conséquence légèrement à l'extérieur de ce qui est
visible à l'écran. Ces 2 noms compensent pour ce léger décalage. Si tous les
écrans sur lesquels tu ouvres le fichier sont à 0, 0 ces 2 noms seraient
inutiles! Tu peux les supprimer comme ceci :

Sub test()
Thisworkbook.Names("MichDLeft").delete
Thisworkbook.Names("MichDtop").delete
End Sub

Et tu peux supprimer le code dans le ThisWorkbook.

Ok, j'avais vu les valeurs en mettant dans le thisworkbook les valeurs à true.
Pour le moment, j'ai apporté des modifs au calendrier d'après ton deuxi ème exemple.
J'ai fait:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Bo olean)
If Not Intersect(Target, Range("P6:P1006")) Is Nothing Then 'if then end if ajouté pour limiter la zone P6:P1006
With frmDPicker
.StartUpPosition = 0
X = Application.ActiveWindow.PointsToScreenPixelsX(((.Left) * 4 / 3))
Y = Application.ActiveWindow.PointsToScreenPixelsY(((.Top) * 4 / 3))
.Left = X * 3 / 4 'Target.Cells(, Target.Cells.Count).Offset(, 1) .Left + frmDPicker.Width / 2
.Top = Y * 3 / 4 'Target.Cells(, Target.Cells.Count).Offset(, 1) .Top + frmDPicker.Height
Application.SendKeys "{ESC}"
.Show
Unload frmDPicker
Application.SendKeys "{ESC}"
End With
End If
End Sub

Sauf que la valeur X devrait être 720. A la limite elle peut être fixe car l'ouverture de l'userform se fait toujours sur la meme colonne.
En revanche pour le Y je suis à la ramasse. Le calendrier s'ouvre avec de s valeurs négatives genre top = - 128 dès lors que je descends dans m a feuille.

JP

Bonjour,

Je t'ai fourni un fichier exemple qui fonctionne bien.
Après avoir compris comment le code opère, tu peux l'adapter de la manière
désirée.
Sauf que c'est à toi de le faire...!

N.B. Pourquoi utiliser des fonctions le plus souvent possible au lien
d'insérer le code dans la procédure?
A ) Cela aide la lecture du code, limite l'étendue de grandes procédures,
facilite le débogage au besoin...
B ) Une fonction lorsqu'elle est bien construite, son utilisation est rapide
par un simple copier-coller dans n'importe quel projetVBA, ce qui permet une
économie de temps important.
C ) Il me semble que tu veuilles réinventer la roue sans trop de succès!

Ca roule:-)
Le code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Bo olean)

If Not Intersect(Target, Range("P6:P1006")) Is Nothing Then 'if then / end if ajouté pour limiter la zone à P6:P1006

Dim X As Long, Y As Double

On Error Resume Next
With Target
'True permet de faire glisser la cellule sélectionnée
'à la position du coin supérieur gauche. Vous pouvez
'omettre de paramètre afin de ne pas déplacer la sélection.

'---------------------
Application.Goto .Cells(1, 1), False '<<<<<====OR TRUE
'---------------------
' 4 / 3 passe du point au pixel pour les besoins de la fonction
X = Application.ActiveWindow.PointsToScreenPixelsX(((.Left) * 4 / 3))
Y = Application.ActiveWindow.PointsToScreenPixelsY(((.Top) * 4 / 3))
End With

With frmDPicker
.StartUpPosition = 0
'3/4 transforme les pixels en point pour tenir compte
'de l'unité de mesure point des propriétés Top et Left
.Left = X * 3 / 4 - 5 + frmDPicker.Width / 2
.Top = Y * 3 / 4 '- frmDPicker.Height
Application.SendKeys "{ESC}"
.Show
Unload frmDPicker
Application.SendKeys "{ESC}"
End With
'la valeur 5.5 et 6 corrige le cadrage de MON écran
'Lorsque la fenêtre de l'application Excel est ouverte pleine grande ur
'c'est les valeurs que retournent ces 2 expressions.
' A = Application.Top ->> -6
' B = A = Application.Left ->> -5.5
End If
End Sub

Merci beaucoup.
En revanche, je n'ai pas compris le rôle de cette ligne de code:

Application.Goto .Cells(1, 1), False

JP