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

patricktoulon

XLDnaute Barbatruc
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
demo2.gif


activx a jumeler

demo3.gif
 

Pièces jointes

  • placement usf.xlsm
    29.4 KB · Affichages: 27
Dernière édition:

patricktoulon

XLDnaute Barbatruc
tu a compris ou on faisait l'erreur dans les multiple versions de mon ptopx

en fait il ne faut pas apliquer le zoom a tout
et pour shunter le freezpane je me sert plus de pointstoscreenpixel(x/y)(la cellule) mais juste du point (0) de cette fonction
le reste c'est le width de la plage(obj,cells(1,1).width qui nous est déjà donné en "point"
de cette manière la ligne ou colonne figé est prise en compte ainsi que les scrollbars ;)

ah oui !! mon utilitaire c'est Licecap
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
allez un petit probleme a régler
pour les activX je souhaiterait injecter que le textbox
autrement dit dans la boucle (do/loop) je souhaiterait l’arrêter quand on arrive avant le userform
manque de pot typename donne le nom du userform et typeof is userform donne vrai pour les frames et multipage , c'est ballo

VB:
Private Sub placementUF()
Dim EcX#, EcY#, X#, Y#
If Not obj Is Nothing Then
    EcX = Me.Width - Me.InsideWidth
    EcY = Me.Height - Me.InsideHeight
    
     X = obj.Left + obj.Width + EcX: Y = obj.Top + obj.Height
    'Do Until TypeOf obj Is UserForm
    'Do While TypeName(obj) = "UserForm"
           Debug.Print obj.Name
         Set obj = obj.Parent
        If TypeName(obj) = "Page" Then Set obj = obj.Parent: Y = Y + (EcX * 3)
        X = X + obj.Left + (EcX / 2): Y = Y + obj.Top + (EcX + (EcX / 2))
    Loop
    Me.Left = X
    Me.Top = Y
End If
End Sub
si vous avez un idée je suis preneur
 

Roland_M

XLDnaute Barbatruc
Bonjour à tous,

comprend pas très bien !? ça fonctionne bien ainsi !?
j'ai essayé avec exit do une fois atteint Page
exemple ici avec Test Ok
Do Until Obj.Name = Userf.Name
Set Obj = Obj.Parent
If TypeName(Obj) = "Page" Then Set Obj = Obj.Parent: Y = Y + (EcX * 3): Ok = 1
X = X + Obj.Left + (EcX / 2): Y = Y + Obj.Top + (EcX + (EcX / 2)): If Ok Then Exit Do
Loop
la position est mauvaise ! même pas sur l'userf !?

EDIT: peux tu joindre un exemple qui ne fonctionne pas stp ?
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour
Je savais qu'on ne pouvais pas savoir si on était dans un UserForm, parce qu'il s'agit en fait plutôt d'un type d'objet spécifique dérivé, habituellement utilisé pour en désigner l'exemplaire par défaut, mais je n'avais pas envisagé que si on n'y était pas, on pouvait être dans un Multipage et non dans un Frame. Corrigée ainsi, ma méthode Position a l'air de marcher dans ce cas :
VB:
   Dim G As Double, D As Double, H As Double, B As Double, U As Object, K As Double, Z As Double, Pge As MSForms.Page
   If TypeOf Obj Is MSForms.Control Then
      G = Obj.Left: H = Obj.Top: Set U = Obj.Parent
      Do:
         If TypeOf U Is MSForms.Page Then
            Set Pge = U: Set U = U.Parent: K = (U.Width - Pge.InsideWidth) / 2
            G = G + U.Left + K: H = H + U.Top + U.Height - Pge.InsideHeight - K
         Else
            K = (U.Width - U.InsideWidth) / 2
            G = G + U.Left + K: H = H + U.Top + U.Height - U.InsideHeight - K
            End If
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
      D = G + Obj.Width: B = H + Obj.Height
   Else
      Z = ActiveWindow.Zoom / 100
      K = GetDeviceCaps(GetDC(0), 88) / 72
      G = ActiveWindow.PointsToScreenPixelsX(Obj.Left * K * Z) / K
      D = ActiveWindow.PointsToScreenPixelsX((Obj.Left + Obj.Width) * K * Z) / K
      K = GetDeviceCaps(GetDC(0), 90) / 72
      H = ActiveWindow.PointsToScreenPixelsY(Obj.Top * K * Z) / K
      B = ActiveWindow.PointsToScreenPixelsY((Obj.Top + Obj.Height) * K * Z) / K
      End If
   Me.Left = (X * (D - G + Me.Width + 6) + G + D - Me.Width - 6) / 2 + 3
   Me.Top = (Y * (B - H + Me.Height + 6) + H + B - Me.Height - 6) / 2 + 3
   End Sub
Peut-être que ça apportera aussi des éléments de réponse à votre question.
 
Dernière édition:

Roland_M

XLDnaute Barbatruc
Bonjour tous le monde,

@patrick: voir avec ta méthode
et voir avec la mienne (incorporée dans mon calendrier depuis toujours, légèrement corrigée)

j'ai rajouté un textbox en page2

EDIT: remarque supprimée ! il y avait erreur de ma part sur un paramètre,! du moins dans le tien !
------ j'ai remis les classeurs corrigés !
 

Pièces jointes

  • __PlacementUserf_Patrick.xlsm
    30.5 KB · Affichages: 13
  • __PlacementUserf_Roland.xlsm
    85.1 KB · Affichages: 21
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour rolland

ton model chez moi ne fonctionne pas du moins c'est pas bon regarde
demo3.gif






et même pire il subit le freezepane , je te met pas l'animation elle est trop lourde mais c'est pas bon du tout


avec mon mon model sur 2007
demo3.gif



mon model sur 2013
demo3.gif




@danreb je vais tester mais ca me plait pas tu met encore des opérateurs en dur -6 et autres
 

Roland_M

XLDnaute Barbatruc
re

alors si ça excel il faut tout laisser tomber ! c'est un jeu de c...

j'ai Windows 7 64bits et Excel 2007 32bits et excel 2016 32bits et tout fonctionne pil poil !
je n'ai jamais eu de retour pareil de la part des utilisateurs du calendrier et dieu sait qu'il y en a quelques un !
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
teste cela simplement dans un userform tout court
et dis moi si tu est bien a droite de la cellule B3 et a son top

VB:
Private Function PtoPx()
    With ActiveWindow.ActivePane:
        PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
    End With
End Function

Private Sub UserForm_Activate()
    Dim EcX#, L1, T1#, zooom#
    EcX = Me.Width - Me.InsideWidth    'ne doit pas subir le zoom
    zooom = (ActiveWindow.Zoom / 100)
    deb = Application.Left    'ne doit pas subir le zoom
    L1 = (ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) * zooom    'subi le zoom
    T1 = (ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) * zooom
    Me.Left = L1 + (Range([b3], Cells(1, 1)).Width * zooom) + EcX
    Me.Top = T1 + (Range([b3].Offset(-1), Cells(1, 1)).Height * zooom) + EcX
End Sub

CHEZ MOI ca fonctionne nikel sur PCfixe AVEC 2007 et 2013 et 2016 sur pc portable
 

patricktoulon

XLDnaute Barbatruc
EN TOUT CAS ca ne me dis pas comment arrêter la boucle do/loop sur le userform quand obj.parent est un userform
comme je disais typeof me donne vrai pour les controls qui ont un handle(frame,multipage,etc.)
et typename me donne le nom du userform c'est ballo!!! :p
 

Roland_M

XLDnaute Barbatruc
re

à propos sur mon message avec les deux classeurs j'avais fait une erreur sur un paramètre(dans le tien!) ! j'ai remis les classeurs !

maintenant concernant l'essai:
avec 2007 c'est ok à droite de B3 (soit en C3)
avec 2016 c'est pas ça !? à droite de la cellule B4 soit en C4 même un peu décalée sur la droite !?
 
Dernière édition:

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou