Autres [Résolu]Affichage userform sur cellule ou activX version simplifiée a tester

patricktoulon

patricktoulon

XLDnaute Barbatruc
bonjour suite a deux discussions ressentes j'ai repris ma méthode et je l'ai simplifiée
normalement avec cette méthode on est dédouané du calcul et prise en charge du freezepane et des scrollbars H et V

aucune Api window ou gdi !!
aucun chiffre en dur dans le code !!!
aucun calcul des scroll ou du freezepane
et l'userform est contraint dans le périmètre de la fenêtre application si il le dépasse
vous voulez bien tester
cellule a jumeler
demo2.gif


activx a jumeler

demo3.gif
 

Pièces jointes

  • placement usf.xlsm
    29.4 KB · Affichages: 27
Dernière édition:
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Comprends pas la réponse. Il me semble que si on n'utilise le PointsToScreenPixelsX que pour déterminer le X de base à gauche on est bien obligé de retrancher du calcul la largeur des colonne manquantes de l'affichage dans la partie fixe et celles manquantes de la partie scrollable si on est au delà, non ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
roland on se croisent
j'avais fait des modifs pour la ligne 1 et le decalge gridline pour le scroll vertical
VB: 
Private Sub placementRange()
    Dim EcX&, EcY&, L1#, T1#
    EcX = 4    '(Me.Width - Me.InsideWidth)
    EcY = Me.Height - Me.InsideHeight
    If ActiveWindow.Zoom > 100 Then EcX = EcX / (ActiveWindow.Zoom / 100)

    L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + ((Range(Obj, Cells(1, 1)).Width - Obj.Width) * (ActiveWindow.Zoom / 100))
    T1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) + EcX + ((0.05 * Obj.Row))) * (ActiveWindow.Zoom / 100) + (Range(Obj.Offset(IIf(Obj.Row > 1, -1, 0)), Cells(1, 1)).Height * (ActiveWindow.Zoom / 100))


    'connaitre le nombre de ligne a ratraper en terme de top
    With ActiveWindow
        R = .ScrollRow - .SplitRow - 1
        If .ScrollRow > .SplitRow + 1 And Obj.Row <= .SplitRow Then
            Set lx = Range(Cells(.SplitRow + 1, 1), Cells(.VisibleRange.Row - 1, 1))
            [A1] = "Rows " & lx.EntireRow.Address(0, 0) & " a ratraper) soit " & lx.Height & "points"
            T1 = T1 + (lx.Height * (.Zoom / 100))
        Else
            [A1] = "0 ligne a ratraper"
        End If

        'connaitre le nombre de colonne a ratraper en terme de left
        C = .ScrollColumn - .SplitColumn - 1
        If .ScrollColumn > .SplitColumn + 1 And Obj.Column <= .SplitColumn Then
            Set cy = Range(Cells(1, .SplitColumn + 1), Cells(1, .VisibleRange.Column - 1))
            [A2] = "Columns " & cy.EntireColumn.Address(0, 0) & " a ratraper)soit " & cy.Width & "points"
            L1 = L1 + (cy.Width * (.Zoom / 100))
        Else
            [A2] = "0 colonne a ratraper"
        End If
        If Obj.Row = 1 Then T1 = T1 - Obj.Height * (.Zoom / 100) 'on remonte en ligne 1
      
      
        'a la base on est en top et left de obj
        ' donc ici tu ajoute la position autour de cette cellule
        'pour la blague j'utilise des constante excel
        'comme postop et posleft sont public et double elle valent 0 (si non renseigné dans l'apel dans le sheets) donc elle sont optional implicitement
        Select Case posTop
        Case xlBottom: T1 = T1 + Obj.Height * (.Zoom / 100)
        Case xlCenter: T1 = T1 + (Obj.Height * (.Zoom / 100)) / 2
            'etc..etc...
        End Select

        Select Case posLeft
        Case xlRight: L1 = L1 + Obj.Width * (.Zoom / 100)
        Case xlCenter: L1 = L1 + (Obj.Width * (.Zoom / 100)) / 2
        Case -1: L1 = L1 - ((Me.Width - Obj.Width) / 2)
            'etc..etc...
        End Select


    End With

    '---------------------------------ICI CONTRAINTE POUR NE PAS SORTIR DE LA FENETRE APPLICATION-----------------------------------
    If L1 < Application.Left Then L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100)
    If L1 > (Abs(Application.Left) + Application.Width - Me.Width) Then L1 = (Application.Left + Application.Width) - Me.Width - EcY
    If T1 > (Abs(Application.Top) + Application.Height - Me.Height) Then T1 = (Application.Top + Application.Height) - Me.Height - EcY

    'application des coordonées
    Me.Left = L1
    Me.Top = T1
End Sub

@danreb
si tu prend le point 0 avec pointtoscreenpixel +ecx /ptopx+ecx tu a la position 0 left ou top

et si tu lui ajoute [A1].left ben position0+0=toujours position0 donc c'est bon
si tu lui ajoute [B1].left ben position0+b1.left = position0+b1.left

position 0 ne veux pas dire 0 par rapport a l'ecran

la base de calcul volet ou pas
Code: 
 L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + ((Range(Obj, Cells(1, 1)).Width - Obj.Width) * (ActiveWindow.Zoom / 100))
    T1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) + EcX + ((0.05 * Obj.Row))) * (ActiveWindow.Zoom / 100) + (Range(Obj.Offset(IIf(Obj.Row > 1, -1, 0)), Cells(1, 1)).Height * (ActiveWindow.Zoom / 100))
on bien theoriquement le left de obj par raport a l’écran en points

je comprend pas bien ta question en fait
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Et moi je ne vois pas comment ce que tu dis peut fonctionner, sauf si la 1ère colonne affichée de la partie fixe est A (pas de scroll avant de figer) et qu'il n'y a pas de Scroll non plus sur le reste.
À moins que le PointsToScreenPixelsX(0) donne toujours la position dans la 1ère colonne visible du volet de la cellule sélectionnée quel qu'y soit le Scroll ? (ou quelque chose comme ça ?)
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
roland avec ta correction je re pers le decalge du cadre userform mais c'est facilement corrigeable

c'est bizarre que tu le perde dans le if du splitrow et splitcolumn y a pas de raison
en fait je vois que tu travailler sur le model non modifié pour le L1 et T1 de depart

chez moi
VB: 
 L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + ((Range(Obj, Cells(1, 1)).Width - Obj.Width) * (ActiveWindow.Zoom / 100))
    T1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) + EcX + ((0.05 * Obj.Row))) * (ActiveWindow.Zoom / 100) + (Range(Obj.Offset(IIf(Obj.Row > 1, -1, 0)), Cells(1, 1)).Height * (ActiveWindow.Zoom / 100))

chez toi
Code: 
L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + (Range(Obj, Cells(1, 1)).Width * (ActiveWindow.Zoom / 100))
    T1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + (Range(Obj.Offset(IIf(Obj.Row > 1, -1, 0)), Cells(1, 1)).Height * (ActiveWindow.Zoom / 100))
et je change rien dans le if splitrow/column
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
@Roland
Code: 
Private Sub placementRange()
    Dim EcX&, EcY&, L1#, T1#
    EcX = 4    '(Me.Width - Me.InsideWidth)
    EcY = Me.Height - Me.InsideHeight
    If ActiveWindow.Zoom > 100 Then EcX = EcX / (ActiveWindow.Zoom / 100)

    L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100) + ((Range(Obj, Cells(1, 1)).Width - Obj.Width) * (ActiveWindow.Zoom / 100))
    T1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(0) / PtoPx) + EcX + ((0.05 * Obj.Row))) * (ActiveWindow.Zoom / 100) + (Range(Obj.Offset(IIf(Obj.Row > 1, -1, 0)), Cells(1, 1)).Height * (ActiveWindow.Zoom / 100))


    'connaitre le nombre de ligne a ratraper en terme de top
    With ActiveWindow
        R = .ScrollRow - .SplitRow - 1
        If .ScrollRow > .SplitRow + 1 And Obj.Row <= .SplitRow Then
            Set lx = Range(Cells(.SplitRow + 1, 1), Cells(.VisibleRange.Row - 1, 1))
            [A1] = "Rows " & lx.EntireRow.Address(0, 0) & " a ratraper) soit " & lx.Height & "points"
            T1 = T1 + (lx.Height * (.Zoom / 100))
        Else
            [A1] = "0 ligne a ratraper"
        End If

        'connaitre le nombre de colonne a ratraper en terme de left
        C = .ScrollColumn - .SplitColumn - 1
        If .ScrollColumn > .SplitColumn + 1 And Obj.Column <= .SplitColumn Then
            Set cy = Range(Cells(1, .SplitColumn + 1), Cells(1, .VisibleRange.Column - 1))
            [A2] = "Columns " & cy.EntireColumn.Address(0, 0) & " a ratraper)soit " & cy.Width & "points"
            L1 = L1 + (cy.Width * (.Zoom / 100))
        Else
            [A2] = "0 colonne a ratraper"
        End If
        If Obj.Row = 1 Then T1 = T1 - Obj.Height * (.Zoom / 100) 'on remonte en ligne 1
        
        
        'a la base on est en top et left de obj
        ' donc ici tu ajoute la position autour de cette cellule
        'pour la blague j'utilise des constante excel
        'comme postop et posleft sont public et double elle valent 0 (si non renseigné dans l'apel dans le sheets) donc elle sont optional implicitement
        Select Case posTop
        Case xlBottom: T1 = T1 + Obj.Height * (.Zoom / 100)
        Case xlCenter: T1 = T1 + (Obj.Height * (.Zoom / 100)) / 2
            'etc..etc...
        End Select

        Select Case posLeft
        Case xlRight: L1 = L1 + Obj.Width * (.Zoom / 100)
        Case xlCenter: L1 = L1 + (Obj.Width * (.Zoom / 100)) / 2
        Case -1: L1 = L1 - ((Me.Width - Obj.Width) / 2)
            'etc..etc...
        End Select


    End With

    '---------------------------------ICI CONTRAINTE POUR NE PAS SORTIR DE LA FENETRE APPLICATION-----------------------------------
    If L1 < Application.Left Then L1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(0) / PtoPx) + EcX) * (ActiveWindow.Zoom / 100)
    If L1 > (Abs(Application.Left) + Application.Width - Me.Width) Then L1 = (Application.Left + Application.Width) - Me.Width - EcY
    If T1 > (Abs(Application.Top) + Application.Height - Me.Height) Then T1 = (Application.Top + Application.Height) - Me.Height - EcY

    'application des coordonées
    Me.Left = L1
    Me.Top = T1
End Sub
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Dranreb à dit:
Et moi je ne vois pas comment ce que tu dis peut fonctionner, sauf si la 1ère colonne affichée de la partie fixe est A (pas de scroll avant de figer) et qu'il n'y a pas de Scroll non plus sur le reste.
À moins que le PointsToScreenPixelsX(0) donne toujours la position dans la 1ère colonne visible du volet de la cellule sélectionnée quel qu'y soit le Scroll ? (ou quelque chose comme ça ?)
Cliquez pour agrandir...

je viens de tester avec AB srcollé donc C visible et figé pour etre a droite il faut ajouter le width de C j'avais pas prevu les figés scrollés

je vais modifier mon model en ajoutant simplement une base du genre
positionleft 0 + [a1].resize(1,activewindow.splitcolumn).width
positiontop 0 + [a1].resize(activewindow.splitrow,1).height

bon je reviens tout a l'heure un client m'a appelé il sait pas que l'on est samedi :p
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
youpi ! pour moi c'est ok à 100%

il me reste à affiner à ma sauce ainsi que les limites écran no soussaille !

sans parler du code, dis moi ce que tu penses après tes essais !
 

Pièces jointes

  • Placement Usf PatrickRoland.xlsm
    36.5 KB · Affichages: 4
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
re

il restera un petit détail à régler concernant les volets
ne pas tester If ActiveWindow.FreezePanes dans Else
mais séparément si c'est haut ou gauche ou les deux !
avec ActiveWindow.SplitRow et Obj.Row (idem colonne)

je verrai ça plus tard ! sinon une fois ça réglé c'est impec !
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bon me revoila
verdict ben non désolé c'est pas bon regarde le colonne figé après les rows figés tu a exactement le même problème que le mien sauf que moi je l'ai dans les 4 parties du sheets
a savoir une perte du top en fonction du scroll vertical

mais on est pas loin j'en suis sur qu'on tient la bonne piste

demo2.gif
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
re

EDIT: on s'est croisé ! TU N'AS PAS REPRIS LE DERNIER ! car ça c'est ok !

en fouillant bien j'ai encore trouvé,
il faudrait simplement séparer les tests ! un truc du genre:
(beaucoup plus facile à gérer au lieu d'imbriquer les tests dans tout en un !)
Code: 
SplitLig = ActiveWindow.SplitRow
SplitCol = ActiveWindow.SplitColumn

If SplitLig = 0 And SplitCol = 0 Then 'aucun volet
   L1 = ActiveWindow.ActivePane.PointsToScreenPixelsX(Obj.Offset(0, 1).Left) / PtoPx * Zoum
   T1 = ActiveWindow.ActivePane.PointsToScreenPixelsY(Obj.Top) / PtoPx * Zoum
ElseIf SplitLig > 0 And SplitCol > 0 Then 'deux volets


ElseIf SplitLig > 0 And SplitCol = 0 Then 'volet haut


ElseIf SplitLig = 0 And SplitCol > 0 Then 'volet gauche


End If
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Lu76Fer
  • Question
XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)
10 11 12
Réponses
178
Affichages
5 K
TooFatBoy
TooFatBoy

Membres actuellement en ligne

8 membres et 86 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 330
Messages
2 087 347
Membres
103 525
dernier inscrit
gbaipc