XL 2019 Positionnement calendrier PatrickToulon

[vgendron]

Bonjour,

Ce post est destiné à @patricktoulon
Ci-joint le fichier avec lequel je m'amuse pour créer des frames contenant des controls taggés date pour déclencher l'ouverture du calendrier
selon le nombre de frame (visibles ou pas sur le formulaire), le calendrier se positionne au bon endroit. ou pas..

 

[Lolote83]

Bonjour @vgendron ,
Et ou voudrais-tu que le calendrier se positionne ?
Chez moi, quelque soit le nombre de frames (enfants) ajoutés, le calendrier se positionne toujours en haut de l’écran.
Ici, les copie d'écran sont sur DATE DEBUT

Exemple 1 - Avec 1 frame

Exemple 2 - Avec 3 frames

Même positionnement que lors d'une seule frame.....

Par contre, je n'ai pas compris

(visibles ou pas sur le formulaire),

Cordialement
@+ Lolote83

 

[vgendron]

hello lolote
effectivement, dans la pj, le calendrier s'affiche toujours en haut.. mais ca. c'est parce que j'ai désactivé une partie du code de patrick (la boucle Do)

le code initial est celui ci

Private Sub placementUF(Obj As Object) 'Version 4.3.2.5
    If Not Obj Is Nothing Then
        Dim Lft As Double, top As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double
        Lft = Obj.Left: top = Obj.top ': Set P = Obj.Parent     ' Normalement Page, Frame ou UserForm
        Do
            PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf P Is MSForms.Page Then Set P = P.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): top = (top + P.top + P.Height - K - PInsHeight)
            If TypeOf P Is Frame Then top = top - P.ScrollTop + 2: Lft = Lft - (P.Width - PInsWidth) / 2 'suppose que le scroll est dans la frame
            If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
        Me.Left = Lft + ((Obj.Width / 2) * Px)     ' a gauche en top
        Me.top = top + ((Obj.Height / 2) * Py)
    End If
End Sub

et le pb arrive lorsque le nombre de frame atteint 6
==> quand il y en a plus que le formulaire peut afficher..
==> lorsque le scroll devient active..

 

[Lolote83]

Re bonjour,
Je regarderai plus trad avec les instructions que tu viens de me donner.
Un taf de dernière minute vient de me tomber sur le crane.
Désolé
@+ Lolote83

 

[vgendron]

pas de souci, il n'y a pas urgence, et patrick est déjà au courant

 

[patricktoulon]

re
bonsoir
puré @vgendron ne commence pas a diffuser mes fichiers avec code tronqués
j'ai fait quelques tests tout à l'heure c'est bien plus complexe qu'il n'y parait
pour le moment j'en suis là mais ça fonctionne pas bien encore

Private Sub placementUF(Obj As Object)
    If Not Obj Is Nothing Then
        Dim Lft As Double, top As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double
        Lft = Obj.Left: top = Obj.top: Set P = Obj.Parent    ' Normalement Page, Frame ou UserForm
        Do
            PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf P Is MSForms.Page Then Set P = P.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): top = (top + P.top + P.Height - K - PInsHeight)
            If TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.Page Then

                Select Case P.ScrollBars

                Case 3    'both
                     top = top - ((P.Height - PInsHeight) / 2) + ((P.Width - PInsWidth) / 2) - 1
                    Lft = Lft - ((P.Width - PInsWidth) / 2)

                Case 1    'horizontal
                  top = top - ((P.Height - PInsHeight))

                Case 2    'vertical
                    Lft = Lft - ((P.Width - PInsWidth) / 2)

                Case Else
                End Select

                If P.ScrollTop > 0 Then top = top - P.ScrollTop
                If P.ScrollLeft > 0 Then Lft = Lft - P.ScrollLeft

            End If
            If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
        Me.Left = Lft + ((Obj.Width / 2) * Px)     ' a gauche en top
        Me.top = top + ((Obj.Height / 2) * Py)
    End If
End Sub

 

[vgendron]

Hello
avec le code post 6, lorsque le P est arrivé au niveau USF, la boucle ne rentre pas dans le select case
je viens de tester avec la condition if suivante

If TypeOf P Is MSForms.UserForm Or TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.Page Then

et ca m'a l'air de bien fonctionner..

 

[patricktoulon]

Bonjour @vgendron montre moi ta version de code en entier svp
car ce que tu dis n'a pas de sens quand la boucle arrive au userform elle est sensé s'arrêter et heureusement

 

[vgendron]

j'ai repris ton code #6 et ajouté un élément dans la condition

Private Sub placementUF(Obj As Object) 'Version 4.3.2.5 "under dvpt"
   
    If Not Obj Is Nothing Then
        Dim Lft As Double, top As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double
        Lft = Obj.Left: top = Obj.top: Set P = Obj.Parent    ' Normalement Page, Frame ou UserForm
        Do
            PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf P Is MSForms.Page Then Set P = P.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): top = (top + P.top + P.Height - K - PInsHeight)
            If TypeOf P Is MSForms.UserForm Or TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.Page Then

                Select Case P.ScrollBars

                Case 3    'both
                     top = top - ((P.Height - PInsHeight) / 2) + ((P.Width - PInsWidth) / 2) - 1
                    Lft = Lft - ((P.Width - PInsWidth) / 2)

                Case 1    'horizontal
                  top = top - ((P.Height - PInsHeight))

                Case 2    'vertical
                    Lft = Lft - ((P.Width - PInsWidth) / 2)

                Case Else
                End Select

                If P.ScrollTop > 0 Then top = top - P.ScrollTop
                If P.ScrollLeft > 0 Then Lft = Lft - P.ScrollLeft

            End If
            If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
        Me.Left = Lft + ((Obj.Width / 2) * Px)     ' a gauche en top
        Me.top = top + ((Obj.Height / 2) * Py)
    End If
End Sub

et donc, si tu ne mets pas cette condition, le Scroll bar du userform n'est pas traité

 

[patricktoulon]

ouais c'est bien ce que je pensais

bien sur que non ca ne peut pas fonctionner

 

[vgendron]

c'est impossible... et pourtant...
voir ma pJ
Par contre, dans mon exemple.. il n'y a Qu'un seul scroll sur le userform..
je ne suis pas allé voir ce que ca donnerait avec un scroll dans chaque objet: ce que tu sembles avoir fait d'après le gif.

 

[patricktoulon]

re
1° déjà c'est faux
regarde le top n'est pas respecté

2° une scroll vertical oui mais elle est a zero et ne peut être modifiée

3° c'est bien beau sur un seul parent mais il faut essayer sur plusieurs parents scrollés avant de dire que ça marche

alors je reprends ton fichier et je le met dans les conditions multiparent ok et on va voir

a au fait je vais quand même lui donner une dimension a ta scrollbars du userform c'est la moindre des choses

allez test ça avec des vraies condition scroll efficientes
tu verra que ça ne peut fonctionner

tu ne fait que du patch ce n'est pas une vrai solution
si demain ton camarade décide de réorganiser son fichier dans des frames tu es mort

de plus j’apprécie moyennement de voir un hersât de mon fichier bricolé pour coller a une seule situation qui ne colle pas totalement d'ailleurs
pour la simple et bonne raison que c'est moi que l'on va venir voir pour arranger ce que je n'ai pas fait
certains diront même le truc de patrick est bidon , alors que je ne suis pas l'auteur des modifs

avant de donner une solution teste tout en bon et du forme

 

[vgendron]

bon, écoute.. la.. je vais te dire ce que j'en pense....
depuis le début, tu ne cesses de me balancer "tu ne réfléchis pas".. "tu fais du patch", "tu découvres au fur et à mesure".. "je vous l'avais bien dit"..... etc etc..
Tu es certainement très bon dans ce que tu fais, mais j'ai quand meme l'impression que tu as tendance à prendre les gens de haut: si tes interventions ne sont pas plus constructives que celles ci, tu peux t'abstenir: on ne t'en voudra pas du tout!

maintenant au sujet de la "solution" que tu as posté au #12
effectivement. elle ne fonctionne pas.. mais je te signale que TU fais une erreur dans ton code
c'est le MULTIPAGE qui n'a pas de scroll, mais le PAGE en a un
donc faire un "if typeof P is page then p=p.parent"
et aller voir le scroll.. bah ca plante...
comme tu es visiblement le plus doué de tous, tu as certainement déjà executé ton code en pas à pas avec des espions sur P

Initialement, mon besoin était juste avec un scroll au niveau formulaire;. et la solution que j'ai me satifsfait très bien.
maintenant. si toi, tu as envie d'aller mettre des scroll partout pour "blinder" ta solution, pas de souci
mais avant de dire qu'on ne comprend rien, assure toi que toi meme, tu ne fais pas d'erreur.

Et comme je n'ai pas vraiment envie d'enchainer des échanges comme tu en as eu sur ton fil "Scroll d'image",
je te salue
et merci

 

[Bertrand Binon]

Pourquoi tant de haine...
On "bricole " pas le programme de quelqu'un d'autre !!!
On lui propose des solutions.
A lui de decider si c'est compatible avec l'ensemble de son programme
Point barre !!!

 

[patricktoulon]

re
ok vgendron dans ce cas la
abstient toi de distribuer mon calendar modifié garde le pour toi comme ça si ça te convient
si tu dois le distribuer ,distribue le au moins dans son état intègre et laisse l'auteur faire les modifs nécessaire
d'ailleurs j'y travaille
c'est le moindre des respects pour l'auteur
merci
quand aux autres qui likent a chaque fois que l'on me bouste ils savent ce que je pense d'eux

donc merci de ne pas éparpiller des hersât