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]

Bon, tu as tout à fait raison, sur le Windows 8 Office 2010 de mon Laptop, il faut effectivement la correction que définit cet écart. Je vais donc supposer que ce test est valide pour les autres configurations qu'il couvre.

Grâce au code que tu as publié et à nos recherches complémentaires...
Au final voici ma proposition de code:

Option Explicit

'--------------------------------------------
'Position UserForm sur un objet de la feuille
'L'objet peut-être une cellule, une TexBox...
'Si l'objet n'est pas dans le Range visible
'le positionnement n'est pas effectué.
'--------------------------------------------
Sub PositionUserFormOnObject(Usf As Object, _
                             TargetObject As Object, _
                             Optional HorizontalShift As Double = 0, _
                             Optional VerticalShift As Double = 0, _
                             Optional UserFormShiftLeft As Boolean = False, _
                             Optional UserFormShiftTop As Boolean = False)
                                    
    Dim Ratio_PointToPixel As Double
    Dim Ratio_PixelToPoint As Double
    Dim Left As Double
    Dim Top As Double
    Dim Zoom As Double
    Dim InchesToPoints As Integer
    Dim Pan As Pane
    Dim OSNumber As Integer
    Dim SpecialShift As Integer
    Dim i As Integer
    Const Shift = 4
    
    'Numéro de version de l'OS
    OSNumber = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1)))
    'Décalage spécial
    If OSNumber = 6 And Val(Application.Version) < 16 Then SpecialShift = Shift
    
    'Récupère les coefficients de conversion Points <-> Pixels
    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
        
        'Recherche dans quel Pane se trouve l'objet cible
        For i = 1 To ActiveWindow.Panes.Count
            Set Pan = ActiveWindow.Panes(i)
            If TargetObject.Left + TargetObject.Width >= Pan.VisibleRange.Cells(1, 1).Left _
            And TargetObject.Left <= Pan.VisibleRange.Cells(1, Pan.VisibleRange.Columns.Count).Left _
                                   + Pan.VisibleRange.Cells(1, Pan.VisibleRange.Columns.Count).Width _
            And TargetObject.Top + TargetObject.Height >= Pan.VisibleRange.Cells(1, 1).Top _
            And TargetObject.Top <= Pan.VisibleRange.Cells(Pan.VisibleRange.Rows.Count, 1).Top _
                                  + Pan.VisibleRange.Cells(Pan.VisibleRange.Rows.Count, 1).Height Then Exit For
        Next i
        
        'Abandon si l'objet cible de l'affichage n'est visible nulle part.
        If i > ActiveWindow.Panes.Count Then Exit Sub
    
        'Positionne le UserForm sur l'objet cible avec les décalages demandés et le décalage spécial
        Left = (Pan.PointsToScreenPixelsX(0) * Ratio_PixelToPoint) + (TargetObject.Left + HorizontalShift + SpecialShift) * Zoom
        Top = (Pan.PointsToScreenPixelsY(0) * Ratio_PixelToPoint) + (TargetObject.Top + VerticalShift + SpecialShift) * Zoom

        'Décale le UserForm à gauche et/ou en haut de ses propres dimensions.
        If UserFormShiftLeft Then Left = Left - Usf.Width
        If UserFormShiftTop Then Top = Top - Usf.Height
    End With
    
    'Positionne le UserForm
    With Usf
        .StartUpPosition = 0
        .Left = Left
        .Top = Top
    End With
End Sub

Et le fichier de démo.

 

[patricktoulon]

si tu cherche bien tu trouvera la discussion que j'ai lancé a ce sujet il y a un bon moment déjà
j'avais fait appel a tous pour tester
et tout les tests (windows version/ office version) m'ont été retournés
si je te dis que c'est bon tu peux me croire
je vais essayer de retrouver cette discussion

 

[patricktoulon]

tiens j'ai retrouver la discussion pour le positionnement
tu y trouvera les versions de @Dranreb et @Roland_M
je recherche la discussion avec tout ceux qui ont testé (je me rappelle plus le titre)

 

[Dudu2]

Oui merci mon @patricktoulon. Ton aide est précieuse.

 

[patricktoulon]

bah.. c'est trop vieux je ne la trouve plus c'est avant 2018
mais dans le lien que je t'ai donné tu y trouvera pas mal de posts qui en parle justement
cette fonction c'est le résultat de pas mal d'heure de tests

je vais faire la mienne et l'ajouter dans le calendar
c'est vrai que je n'y ai pas pensé aux activX dans la feuille
surtout que j'ai d'autres mises a jour pour ce calendar encore à mettre

 

[Dudu2]

Contrôles ActiveX... et aussi Shapes, Images, SmartArts...

 

[patricktoulon]

bon ben voila c'est faitet comme le test ne porte pas vraiment sur le typeof is activX
mais sur différent de range et si parent typeof is worksheet
ben me voila avec une fonction pour activX,shape et tout autres object
pour mon calendar
j'attire ton attention sur la correction que je fait au cas ou le userform dépasserait l'application
c'est pas ergonomique de devoir aller repécher le userform si l'appelant dans la feuille est trop a droite ou trop en bas surtout si tu es en plein ecran pour le classeur

Private Function placementActivXsheets(Obj As Object)
    If Obj Is Nothing Then Exit Function
    Dim z#, EcX#, L1#, T1#, Op&, PtoPx#, Wx#, HX#
    With ActiveWindow
        z = .Zoom / 100
        PtoPx = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        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
        L1 = ((.ActivePane.PointsToScreenPixelsX(Obj.Left) / PtoPx) * z) + (EcX * z)
        T1 = (.ActivePane.PointsToScreenPixelsY(Obj.top) / PtoPx) * z + (EcX * z)
        Wx = (Obj.Width / 2) * z * Px  'meme left ou milieu ou a droite(0,1,2) argument injecté dans showx
        HX = (Obj.Height / 2) * z * Py  'meme top ou milieu ou en dessous(0,1,2) argument top injecté dans showx
        L1 = L1 + (Wx)
        T1 = T1 + (HX)
        If L1 > Application.Left + Application.Width - Me.Width Then L1 = Application.Left + Application.Width - Me.Width - 15
        If T1 > Application.top + Application.Height - Me.Height Then T1 = Application.top + Application.Height - Me.Height - 15
        With Me: .Left = L1: .top = T1: End With
    End With
End Function

 

[Dudu2]

C'est sûrement justifié pour ton calendrier.
Mais justement, je suis sur une application de Planning ou le UserForm est une série de boutons de contrôle et dont une partie n'est pas forcément dans la fenêtre Excel. Et perso je trouve que c'est bien utile.

De toutes façon si tu te lances dans les contrôles, faudrait aussi contrôler que l'objet ciblé pour la position est bien dans un Range visible.
Et si tu dis contrôle, tu dis action corrective. Et là il faut faire des suppositions sur ce que l'utilisateur veux faire.
Je préfère pas rentrer là-dedans. C'est à l'utilisateur de faire en amont les contrôles qu'il trouve judicieux.

 

[patricktoulon]

le obj visible est contrôlé dans mon calendar, un message t'en averti si il est en dehors de l’écran

Et si tu dis contrôle, tu dis action corrective. Et là il faut faire des suppositions sur ce que l'utilisateur veux faire.

a quoi sert d'afficher un userform en dehors de l’écran ?

demo

 

[Dudu2]

a quoi sert d'afficher un userform en dehors de l’écran ?

Ça sert par exemple à avoir un tableau de contrôle indépendant de ce qui se passe dans la fenêtre Excel.
Ça peut servir aussi à afficher des éléments sans masquer tout ou partie de la fenêtre Excel.
Ça dépend de ce qu'on veut faire en fait. Pour une fonction générique, un tel contrôle n'est pas utile et je dirais même pas souhaitable. Pour ton calendrier c'est parfait.

 

[patricktoulon]

re
si c'est pour garder des données sous le coude sans les montrer
dans ce cas la ta fonction elle même est inutile
me.show:me.hide et c'est tout en hide les données dans l'userforms ainsi que l’accès aux properties des éléments a l’intérieur sont toujours dispo
et si c'est pour masquer une partie , ben tu masque la partie c'est tout

après tu fait comme tu veux si tu veux t'amuser a faire des dockside

 

[Dudu2]

si tu veux t'amuser a faire des dockside

Je vais pas utiliser mon RocketDock pour des boutons Excel quand même ?

Est-ce que ton calendrier peut se positionner par rapport à un objet d'un UserForm ?

Pour un feuille on peut tester:
TypeOf ObjetCible.Parent is Worksheet

Pour un UserForm on ne peut pas tester
TypeOf ObjetCible.Parent is UserForm
car cela provoque une erreur de compilation si il n'y a pas de UserForm dans le Projet VBA

Donc il faut passer par cette petite fonction de mon backlog
IsUserForm(ObjetCible.Parent)

'----------------------------------------------------
'Returns True if the Object in argument is a UserForm
'
'TypeOf Is UserForm can't be used if the VBA Project
'has never included a UserForm because the library
'Microsoft Forms 2.0 Object Library is not present in
'the Tools/References, therefore, the UserForm type
'is not known. This function overcomes the issue.
'----------------------------------------------------
Function IsUserForm(Obj As Object) As Boolean
    Dim Usf As Object

    For Each Usf In UserForms
         If Usf Is Obj Then Exit For
    Next Usf

    If Not Usf Is Nothing Then IsUserForm = True
End Function

Le positionnement par rapport à un objet d'un UserForm est un truc à ajouter dans la fonction générique en tous cas.

 

[patricktoulon]

oui!!
tu devrais vraiment aller le voir hein!!!

collection fausse boite de dialogue (Patricktoulon) episode 1 Le calendrier Modal

Bonjour a tous voici ma dernière version de mon calendrier all excel version Une video très courte en bas dette présentation vous montre comment j'installe le calendar de mon fichier dans un autre fichier une autre video dans les mises a...

www.excel-downloads.com

 

[Dudu2]

Ok, j'irai voir et je l'ajouterai dans la fonction générique d'ici quelques jours car je suis sur un truc à finir.

 

[patricktoulon]

re
la fonction dans le userform
ombre est instruit ailleurs dans l'userform mais c'est facultatif en fait
ainsi que px et py
qui vale tout deux 0 ou 1 ou 2) qui correspond au top milieu, en bas pour py et a droite pour px

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