Discussion :

[pijaku]

Les valeurs ne changent jamais avec la fonction Ajuste.
C'est comme si l'on multiplie puis divise par le même coefficient.
Je ne sais pas ce que j'ai fait...

Mon code d'appel avec les valeurs de Top en commentaires :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Dim rectR As RECT, posP As POSITION, BoolRetour As Boolean
    posP = fPosCel(ActiveCell, BoolRetour)
    With UserForm2
        .StartUpPosition = 0
        .Show 0
        .Top = posP.Top
        'ICI .Top = 290,25
        .Left = posP.Left
        .Top = fAjuste(CSng(.Top))
        'ICI .Top = 290,25
    End With
    If BoolRetour = True Then
        rectR = fMarges(UserForm2)
        With UserForm2
            'ICI .Top = 290,25
            .Top = fAjuste(CSng(.Top)) + fAjuste(CSng(rectR.Top))
            'ICI .Top = 290,25
            .Left = fAjuste(CSng(.Left)) + fAjuste(CSng(rectR.Left))
        End With
    End If

et la fonction d'ajustement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Function fAjuste(Valeur As Single) As Single
'Ajustement dû à l'arrondi de la conversion de points en pixels et inversement
Dim pixparpoint As Double
    pixparpoint = fPpx(Application.InchesToPoints(1))
    Valeur = Valeur * pixparpoint ' --->> nb décimal de pixels
    fAjuste = WorksheetFunction.Round(Valeur, 0) ' --->> nb entier de pixels le plus proche
    fAjuste = WorksheetFunction.Round(fAjuste / pixparpoint, 2) ' ---> nb "ajusté" de points
End Function

En fait, à cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Valeur = Valeur * pixparpoint ' --->> nb décimal de pixels

j'obtiens systématiquement un nombre entier.

Je crois que je vais aller me reposer un peu

[patricktoulon]

jacques j'ai essayé avec DWM et avec la correction en dur c'est a dire 3.95 a la place de la fonction marges de pijaku

ca corrige mais pas a 100% et on a quand même un décalage sur certaine colonnes

la différence est de l'ordre de la dimension de l'ombrage

ca reste correcte pour le visuel

[pijaku]

Reste que si les coordonnées spécifiées ne sont pas elles-mêmes exactes, le userform, placé à ces coordonnées, sera placé à des coordonnées non exactes.
Et en ce qui concerne ce SEUL aspect (détermination des coordonnées excates d'une cellule), SEUL PointsToScreenPixels est concerné !

Oui.
PointsToScreenPixels est responsable à lui seul de cette erreur, de ce décalage.

[patricktoulon]

c'est la ou l'on est pas d'accord pointstoscreenpixels fonctionne très bien chez moi en thème autre que aero aucun décalage séquentiel sur x colonne ou sur x lignes que se soit

je t'assure meme pas un pixel de difference ou alors c'est tellement petit que je le vois pas

j'ai même regarder l'écran avec ma loupe de ma trousse d' électronique qui grossi 1000 fois

[unparia]

Je ne sais pas ce que j'ai fait...

Moi non plus, sans voir ce que tu as mis dans la fonction fPpx
Que te retourne donc (on va y voir clair)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
pixparpoint = fPpx(Application.InchesToPoints(1))
msgbox pixparpoint

car si pas correct (et surtout si en plus entier lui-même) , ma foi ...

A Patrick : tu devrais vraiment relire attentivement mon message précédent :
DWM traite sur la base de coordonnées (quelles qu'elles soient) spécifiées. Et il le fait sans faille (le test l'a montré). Si les coordonnées qu'il traite et lui sont communiquées ne sont pas exactes, ce n'est pas DWM qui en est responsable, hein ...

[pijaku]

fPpx est bonne.
Cette fonction c'est celle avec l'objet Shell.
Elle me retourne 1,33333333333333333333333333

Je voulais en avoir le coeur net.
Alors....
J'ai testé PointsToScreenPixels, comme ceci :

Tout d'abord :
> Un gros zoom pour bien positionner le curseur.
> trouver une cellule ou il y a un décalage lors du placement de l'Userform
>> si inexistante alors vous n'avez pas de souci...

Positionner le curseur dans l'angle supérieur gauche de la dite cellule activée, lâcher la souris quand c'est parfait, puis lancer la macro suivante grâce à Alt+F8.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Public Type POSITION
    Left As Double
    Top As Double
End Type
 
Sub aaa()
    Dim P As POINTAPI
    Dim pos As POSITION
    Dim C As Range, dblPpx As Double
    Dim Msg As String
 
    GetCursorPos P
    Msg = "curseur positionné à : " & P.X & " " & P.Y & vbCrLf
    With CreateObject("WScript.Shell")
        dblPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    End With
    Set C = ActiveCell
    With ActiveWindow.ActivePane
        pos.Left = .PointsToScreenPixelsX(C.Left)
        pos.Top = .PointsToScreenPixelsY(C.Top)
        SetCursorPos pos.Left, pos.Top
        Msg = Msg & "Calculé à : " & pos.Left & " " & pos.Top
    End With
    MsgBox Msg
End Sub

J'ai bien une différence, pouvant même être importante (4 ou 5).

[patricktoulon]

après sincèrement personne jusque la n'était arrivé a ce résultat je pense que l'on peut être content de notre travail et dieux sait qu'il y a moultes exemples tous plus faux les uns que les autres
on a bien bossé

je voudrais attirer votre attention une dernière fois sur GetSystemmetrics(56)/ppx

Return the method used to display minimized windows. The return value is a combination of two of the following flags, one specifying a starting position for the minimized icons
and another specifying the direction in which new ones are added:

c'est a votre bon vouloir

[patricktoulon]

fPpx est bonne.
Cette fonction c'est celle avec l'objet Shell.
Elle me retourne 1,33333333333333333333333333

Je voulais en avoir le coeur net.
Alors....
J'ai testé PointsToScreenPixels, comme ceci :

Tout d'abord :
> Un gros zoom pour bien positionner le curseur.
> trouver une cellule ou il y a un décalage lors du placement de l'Userform
>> si inexistante alors vous n'avez pas de souci...

Positionner le curseur dans l'angle supérieur gauche de la dite cellule activée, lâcher la souris quand c'est parfait, puis lancer la macro suivante grâce à Alt+F8.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Public Type POSITION
    Left As Double
    Top As Double
End Type
 
Sub aaa()
    Dim P As POINTAPI
    Dim pos As POSITION
    Dim C As Range, dblPpx As Double
    Dim Msg As String
 
    GetCursorPos P
    Msg = "curseur positionné à : " & P.X & " " & P.Y & vbCrLf
    With CreateObject("WScript.Shell")
        dblPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    End With
    Set C = ActiveCell
    With ActiveWindow.ActivePane
        pos.Left = .PointsToScreenPixelsX(C.Left)
        pos.Top = .PointsToScreenPixelsY(C.Top)
        SetCursorPos pos.Left, pos.Top
        Msg = Msg & "Calculé à : " & pos.Left & " " & pos.Top
    End With
    MsgBox Msg
End Sub

J'ai bien une différence, pouvant même être importante (4 ou 5).

c'est bien ce que je dis depuis un moment en zoom il y a déformation proportionnelle même si c'est pas le zoom le responsable mais bien le thème
puisque ton test chez moi en thème classique Windows est nikel

[unparia]

A Franck. Tu me troubles, là ...
Avant même de parler du reste :
Tu avais écrit :

En fait, à cette ligne :

Valeur = Valeur * pixparpoint ' --->> nb décimal de pixels

j'obtiens systématiquement un nombre entier.

Ce qui est impossible si pixparpoint = 1.33333333333...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CommandButton5_Click()
 
 MsgBox fAjuste(100)
End Sub
Public Function fAjuste(Valeur As Single) As Single
'Ajustement dû à l'arrondi de la conversion de points en pixels et inversement
Dim pixparpoint As Double
    pixparpoint = 1.333333 'fPpx(Application.InchesToPoints(1))
    Valeur = Valeur * pixparpoint ' --->> nb décimal de pixels
    fAjuste = WorksheetFunction.Round(Valeur, 0) ' --->> nb entier de pixels le plus proche
    fAjuste = WorksheetFunction.Round(fAjuste / pixparpoint, 2) ' ---> nb "ajusté" de points
End Function

[unparia]

c'est bien ce que je dis depuis un moment en zoom il y a déformation proportionnelle même si c'est pas le zoom le responsable mais bien le thème
puisque ton test chez moi en thème classique Windows est nikel

Et là, Patrick, tu te contredis.
C'est PointsToScreenPixelsX/Y qui gère à ce niveau-là. Et sa mission est de retourner les coordonnées en pixels à l'écran, quelle que soit la situation (zoom ou pas, etc ...)
Si tu dis que l'utilisation de ta "loupe" a montré que le curseur était bien placé (par setcursorpos), les coordonnées retournées sont celles qu'utilisera DWM (qui se moque d'où elles proviennent. Ce n'est pas son affaire). Mais si pas rigoureusement celles souhaitées, DWM les utilisera également (et si elles ne sont pas les bonnes, hein ...). En d'autres terme : DWM OBEIT et ne discute point

[pijaku]

A Franck. Tu me troubles, là ...
Avant même de parler du reste :
Tu avais écrit :

Ce qui est impossible si pixparpoint = 1.33333333333...

C'est ce que je me suis dit également...
Mais, comme on ne lui envoie que des valeurs en points, la conversion (x pixparpoint), me donne systématiquement un nombre entier.
Avec cette fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Function fPpx(Nb As Long) As Double
    With CreateObject("WScript.Shell")
        fPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / Nb
    End With
End Function
Public Function fAjuste(Valeur As Single) As Single
'Ajustement dû à l'arrondi de la conversion de points en pixels et inversement
Dim pixparpoint As Double, V As Single
 
    V = Valeur
    pixparpoint = fPpx(Application.InchesToPoints(1))
    Valeur = Valeur * pixparpoint ' --->> nb décimal de pixels
    Debug.Print "V : " & V & " Valeur : " & Valeur
    fAjuste = WorksheetFunction.Round(Valeur, 0) ' --->> nb entier de pixels le plus proche
    fAjuste = WorksheetFunction.Round(fAjuste / pixparpoint, 2) ' ---> nb "ajusté" de points
End Function

J'obtient ce type de résultats :

V : 279 Valeur : 372
V : 0 Valeur : 0
V : 279 Valeur : 372
V : 0 Valeur : 0
V : 213,75 Valeur : 285
V : 194,25 Valeur : 259
V : 0 Valeur : 0
V : 194,25 Valeur : 259
V : 0 Valeur : 0
V : 213,75 Valeur : 285
V : 223,5 Valeur : 298
V : 335,25 Valeur : 447

Et donc, comme il n'a rien à arrondir, le résultat de la fonction est systématiquement identique à la valeur d'entrée...

En même temps, quand je prend ma calculatrice et que je fais :
279*1.333333333333, j'obtiens 371.999999999991, que Round va transformer gaiement en 372...

EDIT : oui pour 100 la fonction "fonctionne". Mais ne pas oublier qu'on ne lui envoie que des coordonnées.
Tu peux tester ceci :

MsgBox Ajuste(335,25)

[unparia]

La valeur de sortie ("ajustée") est bien évidemment égale à celle d'entrée lorsque celle d'entrée correspond à un nombre entier de pixels (et donc accepté et laissé tel quel)
C'est un aspect dont il faut savoir profiter.
Je m'explique :
l' "ajustement" n'est vraiment nécessaire que lorsque l'on fait varier ou que l'on définit dynamiquement les propriétés de positionnement. Il ne l'est pas dans les autres cas.
L'aspect exposé au 1er paragraphe nous permet tout simplement d'éviter de traiter différemment selon qu'intervention dynamique ou non. Le code est toujours le même et ne fait aucu_n dégât (l' ajustement ne modifiant la valeur que si nécessaire et la laissant telle quelle si déjà bonne ).

Regarde :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim toto As Single
 toto = fAjuste(100)
 MsgBox toto ' --->>> ajuste car nécessaire
 toto = fAjuste(toto) ' --->> laisse maintenant intacte la valeur d'entrée (puisque acceptée)
 MsgBox toto

[patricktoulon]

même si cela vous intéresse pas visiblement

getsystemmetrics(56) vous est donné pour un dpi de 96 soit 100%

attention uniquement sur W7 donc chez toi pijaku ca doit être bon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Sub testget56()
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    ppxuniversel = 4 / 3    '=1.33333333333333
    coeffppx1TOppx2 = ppx / ppxuniversel  'cooefficient ppxdpi to ppx universel
    If ppx <> ppxuniversel Then
        plus = GetSystemMetrics(56) / coeffppx1TOppx2 / ppx
    Else
        plus = GetSystemMetrics(56) / ppx
    End If
    MsgBox plus
    With UserForm1
        .Show 0
        .Left = plus + ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx
        .Top = plus + ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
    End With
End Sub

une personne avec qui j'étais en discussion dans la communauté Windows(forum) me criait haut et fort que get....(56) devait fonctionner

l'erreur que je faisait était de la diviser par ppx du dpi alors que c'était le ppx universel

attention certaine données de getsystemmetrics son donnée de la même manière pour dpi 96 uniquement je l'ignorais

[pijaku]

attention uniquement sur W7 donc chez toi pijaku ca doit être bon

Ben non.
Car chez moi PointsToScreenPixels ne fonctionne pas correctement.
Avec ta Sub :
Sans aero

Pièce jointe 295639

Et avec :

Pièce jointe 295643

[patricktoulon]

a bon voila autre chose maintenant


sais tu la raison pour la quel ptscpx ne fonctionne pas correctement chez toi

chez moi fixe et portable fonctionnent pareil résultat identique
que donne get...(56) chez toi
EDIT::!!!!!
puré je vois rien tellement c'est petit en dpi 96
en effet tu dois etre en dpi 96 cela donne 6 chez moi

ce qui est étonnant quand je divise ce 6 par 1.25 qui correspond au coefficient dpi 120 to dpi 96 je retombe sur mes 4.8

je reviens je me remet en 120

[mjpmjp]

bonjour,


@+JP

[patricktoulon]

pijaku
je suis curieur de savoir si tu a la même erreur que moi avec mon (+1) que jacques n'aime pas

pointstoscreenpixels te donne -t-il 1 de moins comme moi sur une seuls cellule(ou un seul point de l'écran )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub testpijaku()
 
    [A1].Select
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With ActiveWindow
        wactivecell = (.ActivePane.PointsToScreenPixelsX(ActiveCell.Width) - .ActivePane.PointsToScreenPixelsX(0)) / (.Zoom / 100)
        w2 = (ActiveCell.Width * ppx)
    wa1 = (.ActivePane.PointsToScreenPixelsX([A1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / (.Zoom / 100)
    Wa1bis = [A1].Width * ppx
    deux_cells = (.ActivePane.PointsToScreenPixelsX([A1:B1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / (.Zoom / 100)
 
    End With
    MsgBox wactivecell & vbCrLf & w2 & vbCrLf & wa1 & vbCrLf & Wa1bis & vbCrLf & deux_cells
End Sub

[pijaku]

J'obtiens :
81
81
81
81
161

[patricktoulon]

INCROYABLE!!!!
tu a exactement l'erreur inverse de moi c'est un truc de fou
font elles bien 81 pixel tes cellules
chez moi c'est
---------------------------
Microsoft Excel
---------------------------
103
104
103
104
208
---------------------------
OK
---------------------------

[pijaku]

Les résultats sont corrects.
Pour les cellules testées.
A1 : 81 et B1 : 80