Autres [Résolu]Affichage userform sur cellule ou activX version simplifiée a tester

[patricktoulon]

bonjour suite a deux discussions ressentes j'ai repris ma méthode et je l'ai simplifiée
normalement avec cette méthode on est dédouané du calcul et prise en charge du freezepane et des scrollbars H et V

aucune Api window ou gdi !!
aucun chiffre en dur dans le code !!!
aucun calcul des scroll ou du freezepane
et l'userform est contraint dans le périmètre de la fenêtre application si il le dépasse
vous voulez bien tester
cellule a jumeler

activx a jumeler

 

[patricktoulon]

re
pour le dpi ca va je sais faire sans api avec pointstoscreenpixel ou avec le registre

tu divise pas par 72 mon ptopx

mais j'ai testé de toute façon c'est pas ça
pour les normal c'est 96 donc 100 donc 1 et dpi 120 donc 125 donc 1.25

j'ai testé aussi ecx ecy en prenant en compte le parent a chaque fois, pour multipage j'ai une erreur il n'a pas le insideheight

j'ai constaté aussi que plus de parent il y a plus ca déraille avec ta méthode

sinon j'ai casiment fini de re coder ton calendrier reste la partie férié
beaucoup beaucoup moins de code

je tenterais demain tout avec pointstoscreenpixel voir si ça s'approche plus la je suis out of order

je finirais bien par trouver ca fait des années que je suis dessus par intermittence et on est proche du univercel a 2 doigts pres heu... 2 poils(2 doigts c'est pour le pastaga)

edit tiens je l'ai retrouvé

Function dpi()
With ActiveWindow.ActivePane
dpi = Round(((.PointsToScreenPixelsY(Cells.Height) - ActiveWindow.ActivePane.PointsToScreenPixelsY(0)) / Cells.Height) * 72)
End With
End Function

Sub test()
MsgBox dpi
End Sub

tien

 

[Roland_M]

re
as-tu remarqué ceci:
les fonctions PointsToScreenPixelsX/Y nécessitent que ScreenUpdating=True car si c'est = False les valeurs en retour sont = 0 !?
c'est dommage car de ce fait on voit sauter l'userf du centre à la position de destination !?

as-tu une idée là-dessus pour éviter ça ?

 

[Dranreb]

j'ai testé aussi ecx ecy en prenant en compte le parent a chaque fois, pour multipage j'ai une erreur il n'a pas le insideheight

Ça je savais, c'est le Page qui les a mais celui là n'a aucune propriété de positionnement Left, Top, Width ni Height.
C'est pourquoi je faisais comme je faisais. Mais j'ai simplifié un peu et changé les noms de variable pour que ce soit plus clair.

Public Sub Posit(ByVal Obj As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
Rem. ——— Vous pouvez au préalable positionner l'UserForm par rapport à quelque chose.
'     Obj: Ce par rapport à quoi vous voulez le positionner. X et Y indiqueront comment :
'     X: -1: Collé au coté gauche, 0: Centré horizontalement, 1: Collé au coté droit.
'     Y: -1: Collé au bord supérieur, 0: Centré verticalement, 1: Collé juste en dessous.
'     D'autres valeurs entraineront un recouvrement partiel ou un certain éloignement.
'     Mais rien ne vous empêche de rectifier encore ensuite la propriété Left ou Top
'     de l'UFmCalend pour ajouter un interstice en points au bord de l'objet. Mais toujours
'     avant le Show, donc avant utilisation de la méthode Saisie.
'     X et Y sont facultatifs et assumés = 0. Il est donc centré sur l'objet Obj si non précisés.
   Dim Lft As Double, Rgt As Double, Top As Double, Bot As Double, U As Object, _
      UInsWidth As Single, UInsHeight As Single, K As Double, Zom As Double
   If TypeOf Obj Is MSForms.Control Then
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement Page, Frame ou UserForm
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Page en est pourvu, mais pas le Multipage.
         If TypeOf U Is MSForms.Page Then Set U = U.Parent ' On prend le Multipage, car le Page n'a aucune propriété de Positionnement.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K: Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
      Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
   Else
      Zom = ActiveWindow.Zoom / 100
      K = GetDeviceCaps(GetDC(0), 88) / 72
      Lft = ActiveWindow.PointsToScreenPixelsX(Obj.Left * K * Zom) / K
      Rgt = ActiveWindow.PointsToScreenPixelsX((Obj.Left + Obj.Width) * K * Zom) / K
      K = GetDeviceCaps(GetDC(0), 90) / 72
      Top = ActiveWindow.PointsToScreenPixelsY(Obj.Top * K * Zom) / K
      Bot = ActiveWindow.PointsToScreenPixelsY((Obj.Top + Obj.Height) * K * Zom) / K
      End If
   Me.Left = (X * (Rgt - Lft + Me.Width + 6) + Lft + Rgt - Me.Width - 6) / 2 + 3
   Me.Top = (Y * (Bot - Top + Me.Height + 6) + Top + Bot - Me.Height - 6) / 2 + 3
   End Sub

 

[patricktoulon]

bonjour danreb
oui ce l .parent de page j'avais bien comprismais chez moi 2007 le multipage donc le "page.parent" n'as pas de inside .....il me dit qu'il n'a pas cette propriété

est ce que vous obtenez le meme mesage que moi

Private Sub UserForm_Click()
MsgBox MultiPage1.Height - MultiPage1.InsideHeight
End Sub

mille excuse j'avais pas vu ton commentaire donc je prend le page pour sa caption et le multi pour le height et width
purré

 

[patricktoulon]

re
a ben non c'est pas bon la preuve la ligne s’arrête bien sur ca

serait ce encore une différence entre 2007 et +????

 

[Roland_M]

Bonjour tout le monde

j'ai fais des essais avec l'exemple Dranreb que j'ai collé dans Sub UserformInitPosObjAppelant(Obj, X, Y)'<X/Y en retour

encore que moi c'est différent j'extrais simplement X/Y pour positionner ensuite une fois l'userform.activate !
et ceci, tel quel, fonctionne chez moi avec 2007 et 2016 !

'dranreb
   Dim Lft As Double, Rgt As Double, Top As Double, Bot As Double, U As Object, _
       UInsWidth As Single, UInsHeight As Single, K As Double
'   If TypeOf Obj Is MSForms.Control Then
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement Page, Frame ou UserForm
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Page en est pourvu, mais pas le Multipage.
         If TypeOf U Is MSForms.Page Then Set U = U.Parent ' On prend le Multipage, car le Page n'a aucune propriété de Positionnement.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K: Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
     'Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
      X = Lft + Obj.Width: Y = Top + 3 '< rajout perso
'   End If

 

[patricktoulon]

Bonjour Roland
essaie avec un textbox dans une frame ,dans une frame ,dans une frame ,dans un multipage,userform

c'est plus compliqué que cela roland quand il y a 1 ou 2 parent avant le userform c'est pas trop compliqué mais si il y en a plus ,vos méthodes ne fonctionnent pas je viens de tester
en fait je procéderais autrement mais la je retourne au boulot je regarderais ce soir

et je viens de remplacer mon ecy par une donnée qui ne change pas avec les theme W7
j'utilise commandbars(1).height) pour ecy elle donne 26 chez moi en toute circonstance si chez vous ca colle c'est bon

 

[Roland_M]

bonjour,

c'est vrai, mais franchement, saisir une date dans une dizaine de frame imbriqués, il faut quand même chercher misère, non ?
ce genre de situation doit être plus que rarissime, et c'est c'était le cas et bien l'utilisateur devra adapter point final !
99,9% des utilisateurs seront satisfait comme c'est là !
maintenant si tu trouves ok !

 

[Roland_M]

re

je viens de créer un userform avec textbox dans 5 frames imbriquées, tout ceci dans un multipage,
et bien la fonction de Dranreb fonctionne à merveille ! Merci Dranreb ! franchement à ce niveau là on peut déjà s'en contenter!
la mienne est ok aussi à l'exception de la hauteur dû au multipage qu'il est vrai je n'ai pas tenu compte, mais malgrè tout ça fonctionne

donc la fonction Dranreb (selon mon utilisation bien entendu, qui est d'extraire X,Y pour positionner le calendrier quand celui-ci est activate)

'       ROUTINE STD INIT POSITION X/Y OBJET SUR USERFORM.ACTIVATE
'----------------------------------------------------------------
Public Sub UserformInitPosObjAppelant(Obj As Object, X@, Y@) 'X/Y en retour
   Dim Lft As Double, Rgt As Double, Top As Double, Bot As Double, U As Object, _
      UInsWidth As Single, UInsHeight As Single, K As Double
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement Page, Frame ou UserForm
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Page en est pourvu, mais pas le Multipage.
         If TypeOf U Is MSForms.Page Then Set U = U.Parent ' On prend le Multipage, car le Page n'a aucune propriété de Positionnement.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K: Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do '>
         Set U = U.Parent
      Loop
     'Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
      X = Lft + Obj.Width: Y = Top + 3 '< rajout perso
End Sub

@Dranreb
par contre pour la position sur cellule ça ne fonctionne pas quand il y a ActiveWindow.FreezePanes = True

 

[Dranreb]

Bonjour

vos méthodes ne fonctionnent pas je viens de tester

Vous n'avez apparemment toujours pas compris qu'il faut faire le calcul avec le Height du Multipage et le InsideHeight du Page, donc soit garder momentanément les deux objets sous le coude, comme j'avais fait dans ma 1ère mouture, soit noter les InsideWidth et InsideHeight du Page dans des variables avant de remonter au MultiPage, vu que lui ne les a plus.

 

[patricktoulon]

bonsoir
si danreb j'ai compris pour le page
testez le sur un truc du genre

 

[Roland_M]

Bonjour Patrick,

oui mais là on joue à quoi ? on construit ou on démolie ?

pour l'instant ça fonctionne pour un usage amplement suffisant !
quand il y aura mieux, et bien on le prendra sans hésiter !
le but n'est pas de démolir à chaque fois, mais plutôt d'apporter la solution, tu crois pas ?

pour l'instant ça fonctionne sur ceci:

 

[Roland_M]

re

ceci aussi ok !

 

[Dranreb]

Quand je clique sur le Frame4 de l'UserForm1, mon calendrier se positionne bien où il doit.

 

[Roland_M]

Bonsoir Dranreb,

perso aussi ! tu as vu les exemples que j'ai mis !?
c'est de l'excellent travail, jusqu'à présent personne n'avait apporté la solution !
encore un grand merci à toi ! et merci aussi à Patrick !