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

 

[Dudu2]

C'est quoi un MSForms.MultiPage ?

 

[patricktoulon]

re
ben c'est un controls multipage

 

[Dudu2]

Ok je ne connaissais pas.

 

[Dudu2]

Bon, je reviens là-dessus après quelques détours...
En fait ça ne marche pas du tout

D'une part dans mon fichier test, les Scrolls de Panes perturbent complètement le positionnement.
Donc il faut creuser pour savoir s'il faut chercher le Pane où se trouve l'objet cible de la position.

D'autre part j'ai découvert un truc auquel je ne m'attendais pas !
Le coefficient Pixels to Points calculé selon ta méthode (hors API) tient compte du Zoom.
Donc je ne comprends pas pourquoi il faudrait lui ré-appliquer la correction du facteur de zoom (.Zoom / 100).

Sub a()
    With ActiveWindow
        .Zoom = 100
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 75
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 150
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 100
    End With
End Sub

 

[patricktoulon]

bonjour @Dudu2
et oui je m y attendais tu n'a visiblement pas compris comment fonctionne pointtoscreenpixel(X/Y)
il n'est pas faux ,il correspond a ce que l’écran t'affiche et non la mesure conversive universelle
d'autant plus que les regles changent quen on est en DPI 100 OU 120 (ce qui est mon cas)
comme je te l'ai dis ,dans mon calendrier ou l'exemple simple ,je n'ai aucun problème avec le zoom
il y a bien cependant un petit décalage quand on descends trop bas en zoom surtout avec aéro W7
en effet comme je te l'ai dit ecx est approximatif (c'est pas parfait car il y a bien d'autres choses à prendre en compte)
il y a bien cependant une api gérant le wmd mais j'ai pas jugé utile d'en faire une usine a gaz
démonstration avec zooms différents
sache qu'avec les api getdevicecap etc... pour calculer pointtopixel tu aura le même problème
excel a ses propres mesure si ça t’intéresse tu devrais lire une discussion sur DVP dont je suis l'auteur et échange avec un dénommé unparia c'est pas récent je te le concède(plusieurs années )(il va falloir chercher)

si je devrais te la faire courte je te dirais qu'il te sera impossible de le faire au millimètre près dans tout les zoom

 

[Dudu2]

Ok, testé.

Le coefficient Pixels to Points calculé selon ta méthode (hors API) tient compte du Zoom.

Oui c'est normal de lui affecter le facteur Zoom pour retomber sur un coefficient (Points-to-Pixels et Pixels-to-Points) qu'on obtiendrait via l'API (1,66666 et 0,6 chez moi).

En fait il serait plus juste de lui affecter le facteur Zoom au moment du calcul du coefficient plutôt qu'au moment du calcul des coordonnées.

    Dim Coeff_PointToPixel As Double
    Dim Coeff_PixelToPoint As Double
    Dim Zoom As Double
  
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100

        'Coefficients Pixels <-> Points équivalents API
        Coeff_PointToPixel = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / 72
        Coeff_PixelToPoint = 1 / Coeff_PointToPixel
      
        Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint) + (SheetObject.Left + HorizontalShift + SpecialShift) * Zoom
        Top = (.ActivePane.PointsToScreenPixelsY(0) * Coeff_PixelToPoint) + (SheetObject.Top + VerticalShift + SpecialShift) * Zoom
    End With

 

[Dudu2]

Maintenant reste à régler ce problème de position dans les Panes quand on scroll les Panes.

 

[patricktoulon]

re
1.66666666666667 alors tu est en DPI 120
j'ai testé ta sub a et je ne vois ce que tu trouve d'anormal

Oui c'est normal de lui affecter le facteur Zoom pour retomber sur un coefficient (Points-to-Pixels et Pixels-to-Points) qu'on obtiendrait via l'API (1,66666 et 0,6 chez moi).

et non !!!
réfléchi
tu est en zoom 100
ta cellule [c4] (par exemple) se trouve a 100 pixels du bord de l'ecran !!!!!!! (je parle pas du bord de l'application !!!)
maintenant tu zoom à 70%
ta cellule ne sera plus à 100 pixels du bord de l’écran
PointsToScreenPixelsX(0) --> donne le left de la colonne"A" A PARTIR DU BORD GAUCHE DE L ECRAN!!!
TEL QU'IL EST à L'ECRAN !!!!!!

l’écran LUI !!!!! il n'a pas de zoom!!!!!!

pour de la faire courte ma méthode te donne la situation réelle et non la théorique
peut etre devraije appeler ma fonction Ptopixel_by_zoom pour éviter les meprises
car .ActivePane.PointsToScreenPixelsX te donne la situation réelle déjà calculée

le zoom dans excel n'est u'une vue de l'esprit 1 point sera toujours égal à 1 point fois 1.333333333333333

en gros c'est [c4] du bord de l'ecran en pixel /1.333.. /(Dpi/100)

 

[patricktoulon]

Maintenant reste à régler ce problème de position dans les Panes quand on scroll les Panes.

je sais pas ce que tu a fait mais je le fait déjà avec ma fonction me semble t il

 

[Dudu2]

D'ailleurs voici 2 petites fonctions qui permettent de calculer l'équivalent API des ratios Pixels to Points et Points to Pixels:

Sub Test()
    MsgBox "PointToPixel = " & PointsToPixels & vbCrLf & _
           "PixelToPoint = " & PixelsToPoints
End Sub

'------------------------------------
'Conversion Pixels to Points sans API
'------------------------------------
Function PixelsToPoints(Optional ByVal Pixels As Double = 1) As Double
    Dim Ratio_PointToPixel As Double
    Dim Ratio_PixelToPoint As Double
    Dim InchesToPoints As Integer
    Dim Zoom As Double
   
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100
        InchesToPoints = Application.InchesToPoints(1)
       
        'Coefficients Pixels <-> Points équivalents API
        Ratio_PointToPixel = (.ActivePane.PointsToScreenPixelsX(InchesToPoints) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / InchesToPoints
        Ratio_PixelToPoint = 1 / Ratio_PointToPixel
    End With
   
    PixelsToPoints = Pixels * Ratio_PixelToPoint
End Function

'------------------------------------
'Conversion Points to Pixels sans API
'------------------------------------
Function PointsToPixels(Optional ByVal Points As Double = 1) As Double
    Dim Ratio_PointToPixel As Double
    Dim Ratio_PixelToPoint As Double
    Dim InchesToPoints As Integer
    Dim Zoom As Double
   
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100
        InchesToPoints = Application.InchesToPoints(1)
       
        'Coefficients Pixels <-> Points équivalents API
        Ratio_PointToPixel = (.ActivePane.PointsToScreenPixelsX(InchesToPoints) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / InchesToPoints
        Ratio_PixelToPoint = 1 / Ratio_PointToPixel
    End With
   
    PointsToPixels = Points * Ratio_PointToPixel
End Function

 

[Dranreb]

Bonjour.
À tout hasard j'indique la méthode Posit de mon UFmCalend :

Public Sub Posit(ByVal Obj As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
Rem. ——— Méthode. Vous pouvez au préalable positionner l'UserForm par rapport à quelque chose.
'     Obj: Ce par rapport à quoi vous voulez le positionner. X et Y indiqueront comment :
'     X: -1: Collé au coté gauche, 0: Centré horizontalement, 1: Collé au coté droit.
'     Y: -1: Collé au bord supérieur, 0: Centré verticalement, 1: Collé juste en dessous.
'     Mais si la valeur absolue de X >= 1, Y:=0.9 est une valeur conventionnelle demandant
'        à ce que le bord supérieur du calendrier soit aligné sur celui de Obj.
'     D'autres valeurs entraineront un recouvrement partiel ou un certain éloignement.
'     Mais rien ne vous empêche de rectifier encore ensuite la propriété Left ou Top
'     de l'UFmCalend pour ajouter un interstice en points au bord de l'objet. Mais toujours
'        avant le Show, donc avant utilisation de la méthode Saisie.
'     X et Y sont facultatifs et assumés = 0. Il est donc centré sur l'objet Obj si non précisés.
   Dim Lft As Double, Top As Double, Rgt As Double, Bot As Double, U As Object, UInsWidth As Single, _
      UInsHeight As Single, K As Double, Wnw As Window, P As Long, Pan As Pane, Px72 As Long, Trnq As Long
   If TypeOf Obj Is MSForms.Control Then
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement UserForm, Frame ou Page.
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Multipage n'aura pas de dimensions
         If TypeOf U Is MSForms.Page Then Set U = U.Parent ' intérieures, mais le Page n'avait rien d'autre.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K
         Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
      Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
   Else
      Set Wnw = ActiveWindow: Set Pan = Wnw.ActivePane
      If Intersect(Pan.VisibleRange, Obj) Is Nothing Then
         For P = 1 To Wnw.Panes.Count: Set Pan = Wnw.Panes(P)
            If Not Intersect(Pan.VisibleRange, Obj) Is Nothing Then Exit For
            Next P
         If P > Wnw.Panes.Count Then Exit Sub ' Abandon si la plage n'est visible nulle part.
         End If
      Px72 = GetDeviceCaps(GetDC(0), 88) ' Nombre de pixels pour 72 points.
      Lft = Obj.Left: Trnq = Int(Lft / 3) * 3
      Lft = Pan.PointsToScreenPixelsX(Trnq) * 72 / Px72 + (Lft - Trnq)
      Px72 = GetDeviceCaps(GetDC(0), 90) ' Nombre de pixels pour 72 points.
      Top = Obj.Top: Trnq = Int(Top / 3) * 3
      Top = Pan.PointsToScreenPixelsY(Trnq) * 72 / Px72 + (Top - Trnq)
      K = Wnw.Zoom / 100: Rgt = Lft + Obj.Width * K: Bot = Top + Obj.Height * K
      End If
   Me.Left = (X * (Rgt - Lft + Me.Width + 6) + Lft + Rgt - Me.Width - 6) / 2 + 3
   If Abs(X) >= 1 And Y = 0.9 Then
      Me.Top = Top
   ElseIf Abs(X) >= 1 And Y = -0.9 Then
      Me.Top = Bot - Me.Height
   Else
      Me.Top = (Y * (Bot - Top + Me.Height + 6) + Top + Bot - Me.Height - 6) / 2 + 3
      End If
   End Sub

Elle examine en premier ActivePane, et si la plage n'y est pas visible, les autres ensuite

 

[patricktoulon]

bon je te montre sur une feuille fractionnée parce qu'a mon avis tu t'égare complètement
ma fonction fait déjà tout pourquoi veux tu réinventer la roue ?

 

[patricktoulon]

re
@Dranreb et si la plage est visible dans la pane 1 alors que l'on veux aller dans la pane4 ou la cellule est visible aussi voir demo post précédent

 

[Dudu2]

je sais pas ce que tu a fait mais je le fait déjà avec ma fonction me semble t il

Oui mais je ne sais pas bien comment tu as réglé ce problème.
Faut-il rechercher le Pane dans lequel se trouve l'objet cible pour l'utiliser dans le positionnement ?

 

[Dranreb]

Je ne vais quand même pas ajouter un argument pour indiquer dans quel Pane on le veut.
Ce serait trop bizarre de sélectionner une cellule dans l'un de ceux où la plage est visible tout en voulant quand même l'afficher dans un autre où elle y est aussi