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

Dudu2 · 8 Mars 2021

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

sousou · 8 Mars 2021

Bonjour,
Une piste je ne gère que left ici
Sub PositionnerUserFormEnTextBox1()
Dim x, x1, x2, x3
x = Windows(1).VisibleRange.Left
x1 = ActiveSheet.Shapes("textbox1").Left
x2 = ActiveSheet.Cells(1, Windows(1).SplitColumn + 1).Left
x3 = x1 - x + x2
'MsgBox x3
UserForm1.Left = x3
UserForm1.Top = ActiveSheet.Range("a15").Top
UserForm1.Show
'Call PositionnerUserForm(ActiveSheet.TextBox1)
End Sub

patricktoulon · 8 Mars 2021

Bonjour @Dudu2 et la fonction de mon calendrier elle sert a quoi?
et le modele dans le ressource

placer un userform en lieu et place d'un range

pour placer un userform au niveau d'une cellule il y plusieurs choses a prendre en compte la position de l'application les scrolls vertical et horizontal les ligne éventuellement figées qui faussent les calculs le fractionnement de fenêtre qui...

www.excel-downloads.com

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.

je ne supprime rien dans mon model
le principe
calcul left top ecran( sans api SVP )
plus les range.visible width de la pane gauche et ou haute selon ou la selection se trouve( dans la pane 1,2,3 ou 4
voilà ça n'est plus un challenge

Dudu2 · 8 Mars 2021

@sousou, @patricktoulon,
Merci pour vos propositions Je vais essayer de les importer dans ma fonction.

@patricktoulon, dans ton code lorsque tu écris:

VB:

Dim EcX#
EcX = 4 And Op = 6 And Int(Val(Application.Version)) < 16  'ecart cadre grosse bordures 2007 et Windows 7

Que vaut EcX à la sortie ? 0 ou 1 ?

patricktoulon · 8 Mars 2021

ben il vaut 3 si c'est 2007 avec aero
ou
si tu a mis le theme aero dans W10(même si il n'y a pas la transparence ça compte)

sinon il vaut 0

comment ca marche?
on fait l'addition logique d'un numérique avec un boolean

si la partie boollean est false Alors!!!toute la ligne est false donc la ligne=0 car ecx est une variable double
si c'est pas false c'est -1 donc 4-1=3

autrement dit c'est une conversion en double de 4 +(false ou true)
voila
je sais c'est pas courant

Dudu2 · 8 Mars 2021

Merci pour ton explication.
Pour être franc, ton code est trop complexe pour moi, je ne le comprends pas.
Mais il fonctionne c'est sûr.

VB:

'limite splitrow et splitcolumn
With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With

If .SplitRow > 0 Then  'placement  si dans le splitrow
    If obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(obj, Cells(R, 1)).Height * Z) + EcX
End If

If .SplitColumn > 0 Then    'placement  si dans le splitcolumn
    If obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(obj, Cells(1, C)).Width * Z) + EcX
End If

patricktoulon · 8 Mars 2021

ho!! ben tu peux me croire que j'ai bien galéré moi aussi
@Dranreb et @Roland_M ont fait leur version aussi mais il utilisent des api de conversion point/pixels
moi non et elle est compatible toute versions
si tu comprends pas demande pas de soucis
c'est pas si compliqué en fait quand on connait le raisonnement
mais je reconnais que celle là elle m'a fait souffrir

des tests et des test à n'en plus finir pour comprendre et connaitre les comportements différents selon les situation (figés, ligne,colonne,fractionné) et pour pas faire une usine a gaz

Dudu2 · 8 Mars 2021

Ça peut être simplifié car T1 et L1 on déjà été calculés avant.
C'est déjà un peu plus lisible. En plus si on dézippe les zip instructions...

VB:

'limite splitrow et splitcolumn
With .Panes(1).VisibleRange
    C = .Cells(.Cells.Count).Column
    R = .Cells(.Cells.Count).Row
End With

If .SplitRow > 0 Then  'placement  si dans le splitrow
    If obj.Row < R + 1 And .ScrollRow > R Then
        T1 = T1 - (Range(obj, Cells(R, 1)).Height * Z)
    end if
End If

If .SplitColumn > 0 Then    'placement  si dans le splitcolumn
    If obj.Column < C + 1 And .ScrollColumn > C Then
        L1 = L1 - (Range(obj, Cells(1, C)).Width * Z)
    end if
End If

patricktoulon · 8 Mars 2021

hoh!! je suppose que ça peut être simplifié mais attention !!!!avec le fractionné tu a 4 panes pour l'activewindow
il faudra que je la re regarde

Dudu2 · 8 Mars 2021

De plus avec une instruction comme celle-là L1 = L1 - (Range(obj, Cells(1, C)).Width * Z), ça ne peut pas marcher avec un objet non Range.
Je vais investiguer la méthode à @sousou.

patricktoulon · 8 Mars 2021

je comprends pas ta demande là c'est quoi qui te gene
le range c'est ca
(Range(obj, Cells(1, C))
L1=L1-le width de ce range fois le zoom

Dudu2 · 8 Mars 2021

je comprends pas ta demande là c'est quoi qui te gene
le range c'est ca
(Range(obj, Cells(1, C))

Cette instruction en gras, ça ne peut pas fonctionner si Obj est une TextBox par exemple.

patricktoulon · 8 Mars 2021

heu faut que tu revois mon calendrier toi tu n'a pas bien regarder
non c'est range
pour les controls activX tu a la fonction dans mon calendrier qui fait la même chose pour les activx dans un autre userform

après pour un activx dans une feuille je peux t'en faire une si tu veux c'est beaucoup plus simple qu'un range
il faudra que j'y pense un activX dans une feuille fractionné

tu a la base déjà avec le calcul de retrait des panes

Dudu2 · 8 Mars 2021

Bon en fait je vous ai dérangé pour rien, ou presque ! C'est vraiment tout ~~con~~ bête.
Mais c'est quand même grâce au code de @patricktoulon que j'ai pu voir où ça foirait.
Je faisais:

VB:

With ActiveWindow
    Left = (.PointsToScreenPixelsX(0) * Coeff_PixelToPoint + SheetObject.Left + HorizontalShift) * (.Zoom / 100)]
End With

Et il faut tout simplement faire:

Code:

With ActiveWindow
    Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint + SheetObject.Left + HorizontalShift) * (.Zoom / 100)
End With

La seule chose qui n'est pas vérifiée c'est si l'objet cible est dans le VisibleRange ou pas.
Mais ça je m'en fiche un peu car que faire si c'est pas le cas ?
Il faudrait ajouter une option à la fonction pour dire si on avertit ou si on laisse passer.

patricktoulon · 8 Mars 2021

re
oui en effet les activX ne subissent pas le fractionnement c'est même plus simple que je le pensais

VB:

'--------------------------------------------
'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&
    
    '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
    
        'Calcule la position du UserForm
        Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint + SheetObject.Left + HorizontalShift) * (.Zoom / 100)
        If UserFormShiftLeft Then Left = Left - Usf.Width
        Top = (.ActivePane.PointsToScreenPixelsY(0) * Coeff_PixelToPoint + SheetObject.Top + VerticalShift) * (.Zoom / 100)
        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
        .Top = Top + ecx
    End With
End Sub

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

Dudu2

XLDnaute Barbatruc

sousou

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

placer un userform en lieu et place d'un range

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires