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

[patricktoulon]

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

activx a jumeler

 

[Dranreb]

Le problème c'est que les coordonnées dans VBA sont partout en points. Je préfèrerais qu'elles soient en pixels, on se casserait moins la tête !
Je joins le Calendrier avec les conversions remises dépendantes de la résolution.

 

[patricktoulon]

ben oui c'est MS que veux tu
encore heureusement que l'on a pointstoscreenpixel on serait bien malheureux sinon

 

[patricktoulon]

il est vraiment fourni ton calendrier c'est pas ma cam mais j’apprécie le boulot
pour info si tu prend ma fonction ptopx ca fonctionnera aussi bien chez toi et chez moi et on se dédoine des apis

Public Sub Posit(ByVal Obj As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
    Rem. ——— 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, Rgt As Double, Top As Double, Bot As Double, U As Object, _
        UInsWidth As Single, UInsHeight As Single, K As Double, Zom As Double, Px72 As Long, Trnq As Long
    If TypeOf Obj Is MSForms.Control Then
        Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent    ' Normalement Page, Frame ou UserForm
        Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf U Is MSForms.Page Then Set U = U.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            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
        With ActiveWindow
            Zom = .Zoom / 100
            Px72 = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
            If .FreezePanes Then
                Lft = Obj.Left: Trnq = Int(Lft / 3) * 3
                Lft = .ActivePane.PointsToScreenPixelsX(Trnq) * 72 / Px72 + (Lft - Trnq)
            Else
                Lft = .PointsToScreenPixelsX(Int(Obj.Left * Zom * Px72 / 72 + 0.5)) * 72 / Px72
            End If
            'Px72 = GetDeviceCaps(GetDC(0), 90)
            If .FreezePanes Then
                Top = Obj.Top: Trnq = Int(Top / 3) * 3
                Top = .ActivePane.PointsToScreenPixelsY(Trnq) * 72 / Px72 + (Top - Trnq)
            Else
                Top = .PointsToScreenPixelsY(Int(Obj.Top * Zom * Px72 / 72 + 0.5)) * 72 / Px72
            End If
            Rgt = Lft + Obj.Width * Zom: Bot = Top + Obj.Height * Zom
        End With
    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

 

[Dranreb]

Je n'ai aucune envie de me 'dédoiner' des API. Elle sont faites pour ça, et suscitent probablement moins de calcul.
De plus ce calcul de Px72 ne me semble pas bon par rapport à la suite: il faut calculer le nombre de pixels pour 72 points. En principe c'est toujours un nombre entier. En théorie ça peut aussi différer verticalement et horizontalement.

 

[Roland_M]

bonsoir tout le monde

@Dranreb , ce que tu m'as demandé.

tout d'abord une petite précision, j'allume mon ordi et j'ai les résultats affichés avec les routines ci-dessous
j'étais en 1920x1080 avec ces résultats
je passe en 1600x900 tous les essais sont identiques 96 et 1,333333.....
je repasse en 1920x1080 et là pareil tous idem 96 et 1,33333..... !?!?

c'est qq chose que je ne comprend pas du tout !
je m'en était aperçu une fois, c'est pour ça que j'avais mis 1,60 arrondi dans mon msg
ça se produit par moment sans m'en rendre compte !?
et le pire c'est que je n'arrive plus à le reproduire !? vous allez croire que je suis shooté !
donc pour l'instant c'est 96 et 1,33333.....

'>>>>>> les deux = 1,333333.... celui-ci toujours fiable !
Sub Test()
MsgBox GetDeviceCaps(GetDC(0), 88) / 72 & " pixels par point horizontalement," & vbLf _
& GetDeviceCaps(GetDC(0), 90) / 72 & " pixels par point verticalement.", vbInformation
End Sub

'>>>>>>>>>>>>>>>>>>>>>>> ceci = 1,596709......
Function FPointToPixel1() As Double
With ActiveWindow.ActivePane: FPointToPixel1 = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width: End With
MsgBox FPointToPixel1
End Function

'>>>>>>>>>>>>>>>>>>>>>>> ceci = 1,569444..... DPI=113
Function FPointToPixel2() As Double
Dim DPI As Integer
With ActiveWindow.ActivePane
DPI = Round(((.PointsToScreenPixelsY(Cells.Height) - .PointsToScreenPixelsY(0)) / Cells.Height) * 72)
FPointToPixel2 = DPI / 72
End With
MsgBox FPointToPixel2 & vbLf & DPI
End Function

 

[Dranreb]

Alors donc ce n'est pas une question de résolution ce rapport points / pixels… À vrai dire je n'y ai jamais rien compris. C'est peut être une question de matériel écran alors ?… Les méthodes .PointsToPixelsXY de l'objet Pane sont pour moi assez incompréhensibles dans leurs réactions, mais semblent donner de bons positionnements avec FreezePanes = True. Avec False faut croire que non puisque beaucoup, y compris moi, se sont rabattus sur celles de l'objet Windows, qui, en dépit de son nom, traite des valeurs en Pixels contrairement à celles de l'objet Pane.
Non, non, je ne vais pas croire que tu es shooté, même pas rendu maboule par tous ces mystères abscons !

 

[patricktoulon]

bonsoir tout les deux
savez vous comment identifier la premiere colonne ou ligne des splitrow et splitcolumn
exemple dans cette capture la colonne"C"

 

[Roland_M]

re

content que vous soyez là !
je viens de découvrir d'où venaient ces résultats !
c'est quand j'exécute ces macros sur feuille avec volets figés, sinon c'est ok 96 et 1.3333...
d'ailleurs les résultats sont encore différents quand c'est un volet ou deux !

seul le tien avec les API reste toujours ok 96 et 1.3333333...

je vais modifier mes essais avec les API pour voir !? car peut être faut t'il en tenir compte !?

 

[Dranreb]

LOL j'avais posé une question analogue mais pour la partie fixe au poste #72 !
Depuis, j'avais trouvé des ActiveWindow.Panes(4).VisibleRange.Left mais je n'avais rien réussi à en tirer, jusqu'à ce que je constate subitement et avec surprise que les PointsToScreenPixels de ActiveWindow.ActivePane faisaient le boulot sur les volets figés, alors j'ai cessé de chercher.

 

[patricktoulon]

re
pointstoscreenpixelXY fonctionne très bien il faut en comprendre le principe
en effet vous avez peut être remarqué des mesure (plus ou moins précises) il n'en est rien voir même le contraire elle vous donne ce qui est vraiment a l’écran en fonction du matériel graphique

on peu vérifier mes dires en se servant d'une seule cellule dans mon ptopx
faite les essais avec plusieurs cellules différentes ca démontrera l’aberration du zoom d'excel
je vous fait une démo demain si vous voulez

 

[Roland_M]

re

avec les API il n'est plus besoin de tenir compte du zoom ! je le laisse =1 et sur une feuille neutre zoomée c'est OK !!!!?????
ça change toute la donne ! il faut tout revoir !

 

[Roland_M]

re

sans scroll ceci suffit pour placer l'userf ! même avec volets avec zoom et pourtant sans tenir compte du zoom !
PtToPx = InitPtToPx '< avec API
L1 = ActiveWindow.ActivePane.PointsToScreenPixelsX(Obj.Offset(0, 1).Left) / PtToPx
T1 = ActiveWindow.ActivePane.PointsToScreenPixelsY(Obj.Top) / PtToPx
Me.Left = L1: Me.Top = T1

il restera simplement à voir quand il y a scroll sur les feuilles avec volets car sur feuille sans volet scroll ou pas c'est ok !
quelle trouvaille !!!

 

[patricktoulon]

oui c''est exact roland ce model est presque au point il me manque les ligne et colonnes scrollées dans !!! les splits

teste ca dans un fichier vierge

Sub test3(obj As Object)


    Dim Z#, EcX#, EcY#, L1#, T1#, BandH As Range, BandV As Range, H#, L#
    With ActiveWindow
        Z = (ActiveWindow.Zoom / 100)
        EcX = 2
        EcY = 3

        L1 = (.ActivePane.PointsToScreenPixelsX(obj.Left) / PtoPx) * Z + EcX
        T1 = .ActivePane.PointsToScreenPixelsY(obj.Top) / PtoPx * Z + EcX

        If .SplitRow > 0 Then
            r = Cells(.SplitRow, 1).Row
            If obj.Row < r And .ScrollRow > r + 1 Then
                MsgBox "scrollvertical a rattraper  " & Range(Cells(r + 1, 1), .VisibleRange.Cells(1).Offset(-1)).EntireRow.Address
                T1 = T1 + ((Range(Cells(r + 1, 1), .VisibleRange.Cells(1).Offset(-1)).Height) * Z) - (EcX * Z)
            End If
        End If


        If .SplitColumn > 0 Then
            c = Cells(1, .SplitColumn).Column
            If obj.Column < c + 1 And .ScrollColumn > c + 1 Then
                MsgBox "scrollhorizontal a rattraper  " & Range(Cells(1, c + 1), .VisibleRange.Cells(1).Offset(, -1)).EntireColumn.Address
                L1 = L1 + ((Range(Cells(1, c + 1), .VisibleRange.Cells(1).Offset(, -1)).Width) * Z)
            End If
        End If

    End With

    With UserForm1
        .Show 0
        .Left = L1
        .Top = T1
    End With

End Sub
Private Function PtoPx()
    With ActiveWindow.ActivePane:
        PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
    End With
End Function

evenement sheets

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
test3 Target
End Sub

je travaille sur ce model depuis cet aprem
il me manque ces satanées scrollées dans les split sinon c'est bon

et puis tiens

 

[Roland_M]

EDIT: msg annulé voir soluce ici

https://www.excel-downloads.com/thr...ifiee-a-tester.20035793/page-10#post-20258707

 

[patricktoulon]

oui il me semble te l'avoir dit
pointoscrenn.. prend comme tel a l’écran c'est pour ca que je vous dit que cette fonction marche tres bien et te donne les coordonnées réelles par rapport a l’écran
et c'est pas pile poil 104 pixel pour 62.4 point chez moi en 120 dpi contrairement a ce qu'excel annonce

c'est pour ca que 1.333... ou 1.666... c'est bien mais c'est faux car même a 100% de zoom excel arrange ces colonnes pour l'affichage de la même manière qu'une table HTML d'ailleurs
ca fait des années que je le bidouille ce truc le zoom excel est une belle cochonnerie vous vous en rendrez compte