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

patricktoulon

XLDnaute Impliqué
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
 

Fichiers joints

Dernière édition:

Roland_M

XLDnaute Barbatruc
re

après qq essais je trouve ça extra !
code court, compréhensible, pas d'appel api ! très bien ! je dirai même excellent !

EDIT: quel est l'utilitaire qui permet cette demo animée ?
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
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 Impliqué
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 !
 

Fichiers joints

Dernière édition:

patricktoulon

XLDnaute Impliqué
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 Impliqué
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 Impliqué
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:

arthour973

XLDnaute Barbatruc
Supporter XLD
Bonsoir Patrick, Roland, le forum,

Je suis largué depuis longtemps LOL,

Voilà ce que ça donne chez moi avec 2016 :
PositionUF_Patrick.gif

Super LICEcap Merci Patrick :)
"et oui c'est normal sur W10 il faut enlever la caption (-ecy) "
ça s'enlève où ?
 

Roland_M

XLDnaute Barbatruc
re

@Arthour

veux tu bien essayer les deux classeurs que j'ai mis plus haut Post#7
 

patricktoulon

XLDnaute Impliqué
Avez vous vu mon message #6 où j'arrête ma boucle si le Parent n'est ni un Frame ni un Multipage ?
Bonjour danreb
oui j'ai vu je crois qu'il n'y a que cette solution je vais l'adapter a ma version merci
sur le coup les opérateurs en dur m’avaient refroidi d'ailleurs -6 n'est pas bon chez moi

edit: voila maintenant le userform peut etre inconnu seul le textbox est injecté

VB:
Private Sub placementUF()
    Dim EcX#, EcY#, X#, Y#, go as boolean 
    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
            If TypeName(obj.Parent) = "Frame" Or TypeName(obj.Parent) = "Page" Then go = True Else go = False
            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 While go = True
        Me.Left = X
        Me.Top = Y
    End If
End Sub
 

Fichiers joints

Dernière édition:

Roland_M

XLDnaute Barbatruc
Bonjour à tous,

j'ai essayé sur 2007 ça va, mais avec 2016 pas du tout !

mais j'ai constaté ceci, des valeurs différentes, entre 2007 et 2016,
alors que ce sont des formes identiques, donc forcément ça ne collera jamais !

Avec Excel 2007:
Me.Width - Me.InsideWidth = 4
Me.Height - Me.InsideHeight = 21

Avec Excel 2016:
Me.Width - Me.InsideWidth = 12
Me.Height - Me.InsideHeight = 28

et bizarrement à ma manière ce que je met en dur (car les méthodes ci-dessus ne sont pas fiable)
colle parfaitement avec 2007 et 2016

à mon avis c'est un problème insoluble qui vient des incohérences constatées depuis toujours chez Microsost
problème d'incompatibilité que l'on rencontre sans cesse, entre versions windows et versions excel
la preuve, c'est qu'avec microsoft, on passe sa vie à corriger des bugs plus qu'à travailler !

maintenant qu'il y ai 2, 4 ou 6 points d'écart(même 10) sur la position, franchement ça pose aucun problème.
on n'a pas non plus besoin d'une précision scientifique !
ceux qui ont adopté mon calendrier avec ce calcul de position n'ont apparemment aucun problème !?
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
re
bonjour Roland
peux tu me donner ta version qui fonctionne avec 2007 et 2016

ps j'aime vraiment bien ton calendrier il me fait penser a excel 2003:)
 

Discussions similaires


Haut Bas