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).

 

[patricktoulon]

tiens comme ça on fini le travail

'--------------------------------------------
'Position UserForm sur un objet de la feuille
'--------------------------------------------
Sub PositionUserFormOnSheetObject(Usf As Object, _
                                  SheetObject As Object, _
                                  Optional HorizontalShift As Double = 0, _
                                  Optional VerticalShift As Double = 0, _
                                  Optional UserFormShiftLeft As Boolean = False, _
                                  Optional UserFormShiftTop As Boolean = False)

    Dim Coeff_PointToPixel As Double
    Dim Coeff_PixelToPoint As Double
    Dim Left As Long
    Dim Top As Long
    Dim ecx&
    Dim op&
    Dim zoomer#
    'Récupère les coefficients de conversion Points <-> Pixels
    With ActiveWindow
        Coeff_PointToPixel = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        Coeff_PixelToPoint = 1 / Coeff_PointToPixel
        zoomer = .Zoom / 100
        'Calcule la position du UserForm
        Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint + SheetObject.Left + HorizontalShift) * (zoomer)
        If UserFormShiftLeft Then Left = Left - Usf.Width
        Top = (.ActivePane.PointsToScreenPixelsY(0) * Coeff_PixelToPoint + SheetObject.Top + VerticalShift) * (zoomer)
        If UserFormShiftTop Then Top = Top - Usf.Height
    End With
    
    op = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1)))    'number version system
    ecx = 4 And op = 6 And Int(Val(Application.Version)) < 16  'ecart cadre grosse bordures 2007 et Windows 7

    'Positionne le UserForm
    With Usf
        .StartUpPosition = 0
        .Left = Left + (ecx * zoomer)
        .Top = Top + (ecx * zoomer)
    End With
End Sub

 

[Dudu2]

Y a quand même un truc que je comprends pas (parmi tellement d'autres choses )
Par quoi est déterminé l'ActivePane ? Il a l'air de tomber du ciel.
Pourquoi ne doit-on pas chercher dans quel Pane se trouve l'objet cible ?
Bon, je vais pas en faire une maladie, ça marche comme ça. Mais quand même.

 

[Dudu2]

T'es sûr de ton coup avec cet écart ?
J'aime pô la déclaration des variables avec suffixe.

 

[patricktoulon]

les activeX sont enfant de l'activwindow tout le classeur de la bar de heading à la barre de status donc le calcul se base la dessus
les cellules sont enfants de l'activewindows.activepane quand tu fractionne

 

[patricktoulon]

a oui j'en suis sur chez moi ca corrige presque 5 milimetres
stroumph grincheux n'aime pas les déclarations abrégées

 

[Dudu2]

J'ai fait une erreur de déclaration:

Dim Left As Long ---> Double
Dim Top As Long ---> Double

 

[patricktoulon]

c'est de l'ordre d'un demi milimetre (long/double) c'est pas bien grave

 

[Dudu2]

a oui j'en suis sur chez moi ca corrige presque 5 milimetres

Je te crois sur parole. Bien que ma devise soit "Trust, but verify"

 

[patricktoulon]

ok verifie
sans ecx

avec ecx

 

[Dudu2]

Ok, merci pour la démo.
Mais si tu l'as appelé ecx (perso je préfèrerais ÉcartX, mais bon...) est-ce que ça veut dire qu'il ne s'applique que sur l'axe des X ?
Et si c'est le cas, le code l'inclut aussi sur l'axe des Y.
De plus tu peux le mettre direct dans le calcul, si ecx est calculé en amont évidemment:

Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint + SheetObject.Left + HorizontalShift + ecx) * (zoomer)

Dans le code que tu as publié ecx est sur les 2 axes.
Par contre il n'est pas soumis au Zoom.

 

[patricktoulon]

comme je l'ai fait post # 16 ,il est soumis au zoom et oui il faut qu'il le soit

tu peux pas positionner left ou top a x et y *zoom et ajouter l’écart en point zomm 100
après appelle le comme tu veux

 

[Dudu2]

Donc cet écart s'applique aussi bien en largeur qu'en hauteur ? Sûr ?
Dans le code que tu as publié tu met ce commentaire:
'ecart cadre grosse bordures 2007 et Windows 7
C'est seulement la bordure gauche ou aussi lé bordure haute ?
J'ai un moyen de tester sur Windows 7 Excel 2016 32 bits ?

 

[patricktoulon]

Bonjour @Dudu2
oui cet ecart s'applique en largeur et en hauteur
a vrai dir l’écart Y n'est pas tout a fait pareil que l’écart X mais c'est de l'ordre de 3 décimales donc du pipi de chat
si tu a windows7 et 2016 l'addition logique devrait te donner zero car
l'app 2016 n'affiche pas les useforms avec le cadre des fenêtres windows aéro
tout du moins me semble t il je ne sais plus (à vérifier )
mais bon ma fonction a fait le tour du monde et je n'ai pas eu de retour alors
en gros c'est pas parfait mais c'est mieux que sans

 

[Dudu2]

OK merci pour tes infos.

 

[Dudu2]

'Numéro de version de l'OS
OperatingSystem = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1)))
'ÉcartOS vaut 4 si OperatingSystem = 6 et Version Office < 2016
'ÉcartOS vaut 0 sinon
ÉcartOS = 4 And OperatingSystem = 6 And Val(Application.Version) < 16

En fait l'écart c'est un AND des valeurs:

• 4 qui donne en fait la valeur de l'écart à appliquer si les 2 conditions suivantes sont réunies
• True (-1) si OS = 6 par exemple pour Windows 7 (Autres versions de Windows ?)
• True (-1) si Version Office < 16.

________4 -> 0000000000000100
___OS = 6 -> 1111111111111111
Office<16 -> 1111111111111111
___AND = 4 -> 0000000000000100

Donc le AND vaut 4 si OS = 6 et si Version Office < 2016.
Et 0 sinon

Ce AND savant et incompréhensible à la première lecture par le néophite que je suis (pour faire genre je suis un pro du code que tu peux pas comprendre) est remplaçable par un simple test:
If OS = 6 and VersionOffice < 16 then Écart = 4

Ceci dit ça m'a permis de comprendre enfin pourquoi True = -1 et pas True = 1.

Donc pour un Office 2013 ou 2010 sous Windows 7, il y aurait lieu d'appliquer l'écart.
J'ai encore des doutes. Je vais vérifier sur mon PC portable.