XL 2016 VBA Challenge - Positionner un UserForm sur Objet feuille dans une feuille fractionnée

[Dudu2]

Bonjour,

Positionner un UserForm sur une cellule, une TextBox ou un autre objet d'une feuille ça se fait assez facilement.

Par contre positionner le même UserForm sur cet objet quand la feuille est fractionnée, je n'y arrive pas directement.
La seule solution que j'ai pu trouver est de supprimer temporairement le fractionnement. Mais ce n'est pas très "élégant". De plus cela génère un léger mouvement d'écran induit par la suppression temporaire du fractionnement.

Le "challenge" en question consiste donc à trouver la position (Top et Left) de l'objet feuille dans la feuille fractionnée sans recourir à cet artifice de manière à positionner correctement le UserForm.

Ci-joint le fichier qui fait ça en utilisant l'artifice de suppression temporaire du fractionnement.
Si il y a une solution qui se passe de cet artifice, je préfèrerais.
Merci par avance.

Voir solution (spécifique) en Post #31 (pour positionner un UserForm sur un Objet d'une feuille).
Voir solution (générale) en Post #72 (pour positionner un Objet sur un autre Objet).

 

[Dranreb]

Bonjour
Pourquoi n'utilisez vous pas mon code assez court ?
Il a une boucle pour simuler un principe récursif ! En effet un Frame pourrait être dans un autre Frame etc.

 

[Dudu2]

Bonjour @Dranreb,

Bonne remarque sur le problème de l'imbrication possible des Frames et MultiPages sur lequel je vais me pencher. Je connais mal ces objets.
Ton / votre code est plus court, c'est vrai, il même dense, très dense. Perso, je ne le comprends pas. Vous êtes trop "concentré" et expert pour moi. Je ne sais pas ce que représentent ces +/- 0.9 et +/- 6 dont je n'ai pas besoin pour les calculs.

C'est pour ça que j'ai fait des essais avec du code de mon coté pour essayer comprendre comment ça fonctionne. Avec un code plus long car généreusement commenté, avec des lignes blanche et de espaces, une instruction par ligne, voire sur plusieurs lignes pour bien séparer les éléments, des noms de variables auto-descriptifs donc évidemment plus longs. J'ai toujours codé comme ça en pensant avant tout à la maintenance, même si c'est moi qui doit la faire. A mon âge on ne change pas ses habitudes

 

[Dranreb]

Oui mais il viennent en dernier, après que les Lft Top bruts aient été calculés !
Moi aussi je pense à la maintenance, c'est pourquoi je tasse un maximum le code pour englober toute la structure d'un bloc, boucle ou autre, dans un groupe d'instruction visibles simultanément. Je déteste les codes délayés comme ça où on ne voit plus du tout où ça commence et où ça finit.

 

[patricktoulon]

re
perso moi aussi j'utilise une boucle simple juqu' au object userform et ça fonctionne très bien
je ne sais pas ce que veux fabriquer Dudu2
si je ne me trompe pas
le frames ont un windowlong sans caption réduite à 4 les multipages ont un windowlong de 15
les listbox ont 1 et cela tu le retrouve même dans l'api getsytemmetric de base
ces cotes changent quand on met la bordure donc + de 1.25
parti de la tu veux calculer quoi????
la seule chose qui est à calculer c'est le retrait ecx (selon les versions de W et d' Excel) avec une méthode ou une autre et encore là si on devrait bien faire il y a une api pour ça (gérant le calcul avec aero) mais je ne me souviens plus le nom
c'est vieux vieux vieux

 

[Dudu2]

Pour ces Objets Je vais faire un boucle pour remonter au UserForm. Ça me semble le plus simple.

 

[patricktoulon]

re
tu a déjà 2 versions a ta dispo
la mienne dans le calendar

Private Sub placementUF(Obj As Object)
    If Not Obj Is Nothing Then
        Dim Lft As Double, Rgt As Double, top As Double, Bot As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double, Zom As Double, Ombre As Double, EcX As Double, OpWin As Long
        OpWin = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1)))    'number version system
        If OpWin = 6 Or Int(Val(Application.Version)) < 16 Then EcX = 2: Ombre = 2 Else EcX = 0: Ombre = 0     'ecart cadre
        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 Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
        Me.Left = Lft + EcX + Ombre + ((Obj.Width / 2) * Px)    ' a gauche en top
        Me.top = top + 2 + Ombre + ((Obj.Height / 2) * Py)
    End If
End Sub

je vois pas trop ce que tu cherche a réinventer

 

[Dudu2]

Voilà, c'est corrigé. Post #72.
Encore des lignes d'espacement et de commentaires et des instructions multi-lignes pour bien voir les différents éléments de l'addition séparément .

 

[Dudu2]

tu a déjà 2 versions a ta dispo

J'ai fait une fonction générique pour positionner un Objet sur un autre Objet.

Ta fonction positionne un UserForm sur un Control d'un autre UserForm ou un autre UserForm.
La fonction de @Dranreb, si j'ai bien compris, ajoute à la tienne la possibilité de positionner un UserForm sur un Objet de feuille.
Il y a un avantage à faire ma version. Je comprends 100% de ce que j'ai écrit.

 

[Dudu2]

Je déteste les codes délayés comme ça où on ne voit plus du tout où ça commence et où ça finit.

Moi c'est le contraire. Je déteste les codes compressés au maximum et totalement illisibles. Le Zip-coding inmaintenable. Ça ne passe passe pas la 1ère minute d'une revue de code en entreprise.
Comme quoi à chacun sa façon de voir.

 

[Roland_M]

Bien le bonjour à tous,

On a déjà eu cette conversation et chaque fois c'est la même chose !
Faut avouer que les codes deviennent vite indigestes pour un utilisateur lambda.
J'ai moi même utiliser ces codes, avec l'aide de Dranreb, Patrick ... encore merci à eux !

Pourtant, on résout tous les problèmes, très simplement, en utilisant la position de la souris.
Pour positionner un control, sur un userf ... utilisez simplement GetX et GetY

'dans un module api souris
'-----------------------------
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As LongPtr
#Else
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As LongPtr
#End If
#Else
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
#End If
Private Type POINTAPI: PosX As Long: PosY As Long: End Type
Private Npoint As POINTAPI
Public Function GetX() As Long: GetCursorPos Npoint: GetX = Npoint.PosX * 0.75: End Function
Public Function GetY() As Long: GetCursorPos Npoint: GetY = Npoint.PosY * 0.75: End Function
'-------------------------------------------------------------------------------------------

'dans thisworkbook, par exemple ou code feuille, quand double clic sur cell
'--------------------------------------------
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
UserForm1.Show: Cancel = True
End Sub

'dans userform.activate pour positionner
'---------------------------------------
Private Sub UserForm_Activate(): Me.Left = GetX: Me.Top = GetY: End Sub

 

[patricktoulon]

Bonjour Roland_m
ça faisait un moment