Autres ceci surtout à PatrickToulon et certains utilisateurs !?

[Roland_M]

Bonjour à tous,

Bien le bonjour à toi Patrick, il s'agit d'une fonction venant de toi,
je m'en sert beaucoup, car c'est efficace, sans API, hyper simple, encore bravo !

je voulais juste faire une petite remarque à propos de cette formule, ce qui ne met pas en cause son efficacité !
au cas ou certaines personnes s'en serviraient, encore faut t'il qu'ils s'en servent sur Excel 2007 !?
car c'est de ça qu'il s'agit ! encore que sur d'autres versions à venir . . . !?!

j'ai remarqué qu'avec Excel 2007, si Application.ScreenUpdating=False, PtoPx=0
alors que j'ai aussi Excel 2016 et ça ne le fait pas !?

ceci pour essai:
Private Function PtoPx()
'Application.ScreenUpdating = False
Z# = 100 / ActiveWindow.Zoom
PtoPx = (ActiveWindow.ActivePane.PointsToScreenPixelsX(3) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 3 * Z
MsgBox PtoPx
End Function

bien entendu j'ai solutionné ça.

 

[Roland_M]

merci !

 

[patricktoulon]

@TooFatBoy
combien la fonction dpi te donne

Function dpi()
   dim z#
   With ActiveWindow.Panes(1)
        Z# = .Parent.Zoom / 100
        dpi = ((.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0))) / Z
    End With
End Function
Sub ESSAI2()
    MsgBox dpi
End Sub

 

[TooFatBoy]

Ben 96 puisque je suis en zoom 100 %.
(96 est le résultat affiché par la MsgBox)

 

[Roland_M]

sur ta fonction position sur cell il y a ceci:
'on calcule les coeffs (points to pixel) sur la panes(1) (obligatoire!!!)
PtsToPxX = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72) 'définit le coeff point to pixel horizontal
PtsToPxY = ((.Panes(1).PointsToScreenPixelsY(96) - .Panes(1).PointsToScreenPixelsY(0)) / 96) 'définit le coeff point to pixel vertical
'définit le coeff zoom
Z = .Zoom / 100
'on récupère le PointsToScreenPixels( X et Y) sur la pane concernée
PosXY(1) = ((PaN.PointsToScreenPixelsX(Int(Cell.Left)) / PtsToPxX) * Z) 'left en point
PosXY(2) = ((PaN.PointsToScreenPixelsY(Int(Cell.Top)) / PtsToPxY) * Z) ' top en point

quand zoom est différant de 100, exp 75 , ceci:
PosXY(2) = ((PaN.PointsToScreenPixelsY(Int(Cell.Top)) / PtsToPxY) * Z) ' top en point
n'est valable quand mettant PtsToPxX)
PtsToPxX = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72)
ça fonctionne bien qu'avec ceci pour Horizontale ou Verticale

 

[patricktoulon]

@Roland_M
adapter de mon tutoriel pointstoscreenpixels version 2022
le userform se positionne a gauche et top de la cellule
et toujours valable pour les feuille avec ligne et ou colonne figées ou feuille fractionnée
extrait du calendar V 4.4.2( 2021 (non distribué) et adapté pour toi

il y a toujours le correctif a la fin pour l’empêcher de sortir du cadre de l'application
dans le userform

Option Explicit
Public obj As Range
Public IndexPane&
Private Sub UserForm_Activate()
    placementRange obj
End Sub

Private Function placementRange(obj As Object)
    If obj Is Nothing Then Exit Function
    ' collection  Fonctions avec PointsToScrenPixels(X Y) / Activewindow / Activepane / panes(1 to 4) / visiblerange etc...
    ' récupérer la distance (des bords de l’écran a la cellule désignée)en points théoriques en incluant le freezepane et figés et c....
    ' version 2.0
    ' date février 2022
    ' auteur :patricktoulon
    ' Code  simplifié
     Dim PtsToPxX#, PtsToPxy#, TheZoom#, PaN As Pane, Eq As Boolean, Addr$, ip&, L1, T1, I&
    With ActiveWindow
        Eq = IndexPane > 0: Addr = obj.Address(0, 0): ip = IndexPane
        If IndexPane > .Panes.Count Or IndexPane = 0 Then Set PaN = .ActivePane: IndexPane = .ActivePane.Index Else: Set PaN = .Panes(IndexPane)
        If .FreezePanes = True Then
            For I = 1 To .Panes.Count
                If Not Intersect(obj, .Panes(I).VisibleRange) Is Nothing Then Set PaN = .Panes(I)    '.Index:
            Next
        End If
        If Eq = True And Intersect(obj, .Panes(IndexPane).VisibleRange) Is Nothing Then
            L1 = 0: T1 = 0
            MsgBox Addr & " n'est pas VISIBLE!!! dans la pane " & ip: Exit Function
        Else
            PtsToPxX = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72)    'défini le coeff point to pixel horizontal
            PtsToPxX = Array((4 / 3), (4 / 3) * 1.25)(Abs(PtsToPxX > 1.4))
            TheZoom = .Zoom / 100                     'défini le coeff zoom
            L1 = ((PaN.PointsToScreenPixelsX(Int(obj.Left)) / PtsToPxX) * TheZoom)    'left en point
            T1 = ((PaN.PointsToScreenPixelsY(Int(obj.Top)) / PtsToPxX) * TheZoom) - IIf(Not .FreezePanes, 1, 0)    'top en point
        End If
   End With
        L1 = L1 '+4'pour 2007  ou window 7 avec version inf  à 2016
        T1 = T1 '+4'pour 2007  ou window 7 avec version inf  à 2016
     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 Function

dans un module standard

Option Explicit
Sub test_C4_panne_automatique() 'figé ou non figé fractionnée ou non fractionné normal
    With UserForm1
        .startupposition = 0
        Set .obj = [C4]
        .Show
    End With
End Sub


Sub test_A1_erreur_de_pane() 'on test A1 en pane 4 dans figé(ce qui devrait donner une erreur bien sur
    With UserForm1
        .startupposition = 0
        Set .obj = [a1]
        .IndexPane = 4 'si non fractionnée ou figé la panne est automatiquement reduit a 1
        .Show
    End With
End Sub

Sub test_G9_en_pane4_dans_figé_ou_fractionné()
    With UserForm1
        .startupposition = 0
        Set .obj = [g9]
        .IndexPane = 4
        .Show
    End With
End Sub
Sub test_G9_en_pane3_dans_figé_ou_fractionné()
    With UserForm1
        .startupposition = 0
        Set .obj = [g9]
        .IndexPane = 3
        .Show
    End With
End Sub

 

[Roland_M]

merci je vais regarder à ça !
bonne après midi !

 

[patricktoulon]

ok bon aprem'

 

[patricktoulon]

je viens de détecter des erreurs
tout du moins le intersect ---> message si non visible dans le visible range de la pane indiqué explicitement ou implicitement ne fonctionne pas très bien
j'ai détecté aussi un soucis de zoom
je corrige tout ca

 

[TooFatBoy]

Ben 96 puisque je suis en zoom 100 %.
(96 est le résultat affiché par la MsgBox)

Est-ce que ça explique la non constance de la valeur qui varie : 1,3 ou 1,6 ?

 

[patricktoulon]

re
tu est en dpi 96????!!!!!!
alors tu n'es pas en 111
non la non constance c'est à cause du zoom de excel qui est particulier + le fait que vba arrondi dans ses calculs
et si tu n'es pas constant avec le correctif ça veux dire qu'il faut encore prendre un paramètre en plus

 

[TooFatBoy]

tu est en dpi 96????!!!!!!
alors tu n'es pas en 111

Ma dalle est en 111 DPI d'après mes calculs, et je suis en zoom 100 % au niveau de Windows, donc je suis en 111 DPI.
La fonction de #32 me donne 96 parce que je suis en zoom 100 % au niveau de Windows.

C'est tout ce que je peux dire. Le reste, je n'y comprends rien...

 

[patricktoulon]

re
essaie ça et dis moi

Function Reg_PtoPX() As Double
Reg_PtoPX = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
End Function

Sub test()
MsgBox Reg_PtoPX
End Sub

 

[TooFatBoy]

1,3

 

[ChTi160]

Bonjour le Fil
Moi 1,3333333333333 lol
100% écran ( 1920x1080 )
Bonne Journée
Jean marie

 

[patricktoulon]

re
bonjour @ChTi160 merlleurs veux pour cette année
merci du retour du est en dpi 96 soit 100%