Discussion :

[patricktoulon]

oupss!! "connes/colonnes" non il faut tes deux colonnes identiques pour le test

ne pas oublier aussi que chez moi je suis en 120 dpi

1pixel *125%=1.25( 1.25 pixel étant impossible ca donne toujours 1)

[patricktoulon]

atu une dim identique avec ca

Code :

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

1
2
3
4
5
6
7
Sub testpijaku2()
 With ActiveWindow
 w1 = (.ActivePane.PointsToScreenPixelsX([A1:F1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / (.Zoom / 100)
w2 = (.ActivePane.PointsToScreenPixelsX([g1].Left) - .ActivePane.PointsToScreenPixelsX(0)) / (.Zoom / 100)
End With
MsgBox w1 & vbCrLf & w2
End Sub

[pijaku]

Je ne comprends pas pourquoi tu t'obstines à me faire tester des cellules au hasard.

Je t'ai dit que, dans la plupart des cas, PointToScreenPixels(X/Y) renvoie les bonnes coordonnées, mais, dans certains cas, sur certaines cellules, ces coordonnées sont fausses.

Il est inutile de tester les cellules ou tout se passe bien!

Quand aux cellules ou la méthode ne fonctionne pas, on ne pourra rien y changer.

Si tu recherches la perfection absolue dans tous les cas de figure, il faut se passer de PointToScreenPixels.

Bon courage!

EDIT : pour ma part :
> les fonctions développées ici fonctionnent dans la plupart des cas
> lors d'erreurs elles sont quasi insignifiantes
Par conséquent, je considère qu'un avertissement à l'utilisateur suffit.
D'autant que l'échec ne nous est pas imputable.

[patricktoulon]

chez moi l'erreur de "1" est sur toutes les cellules (n'importe la quelle)

avec pointstoscreenpixelsx(une seule cellule.width)

pour être précis elle sur n'importe quel point de l'écran avec pointstoscreenpixelsx(une cellule.leftt)

[pijaku]

Je crois, Patrick, que tu n'as pas modifié la hauteur des lignes ni la largeur de tes colonnes pour faire tes tests.

Essaye, tu comprendras mieux.

[patricktoulon]

j'étais vraiment curieux avec W10
j'ai donc installé W10 2010 sur mon portable

et on a vraiment a boire et a manger la dedans

voila ce qu'il me faut pour avoir un résultat parfait sur toutes les celles je dis bien sur toutes les cellules en dpi 96 et a tout les zooms

je n'ai aucune différence sur n'importe quelle colonne

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
Sub test()
With CreateObject("WScript.Shell")
        ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72 ' Application.InchesToPoints(1)
    End With
MsgBox ppx
With ActiveWindow
x = (.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) - 2
y = (.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx) - 1
End With
With UserForm1
.Show 0
.Left = x
.Top = y
End With
End Sub

je reviens je vais éssayer en dpi 120

et voila pour dpi120 et meme resultat sauf que la surprise surprise j'ai le defaut sequentiel des colonnes
le responsable est donc bien le dpi modifié

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
Sub test()
With CreateObject("WScript.Shell")
        ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72 ' Application.InchesToPoints(1)
    End With
MsgBox ppx
With ActiveWindow
x = (.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) - 2
y = (.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx) - 3
End With
With UserForm1
.Show 0
.Left = x
.Top = y
End With
End Sub

après si je prends la calculette
que je fait 1.333333333333333*1.25 (125%par dpi120)
j'obtiens pas le ppx que l'on a l'habitude d'utiliser en dpi 120

1,666666666666666


donc quand je remplace ppx par ce nombre j'obtiens le même résultat que dpi 96 seulement sur les cellules qui ne donne pas une fausse donnée en terme de left et top

des que je rentre du bureau j'essai sur le fixe avec Windows 7

[unparia]

J'aimerais vraiment (et c'est important pour y voir clair) que l'on série les problèmes.
Nous avons déjà (le dernier test que j'ai proposé plus haut) traité le cas de l'application SEULE de DMW et constaté qu'elle était sans faille.
Il convient maintenant de traiter celui de la SEULE application] (sans rien d'autre) de la méthode PointstoScreenPixelsX/Y
Le moyen de le faire est exposé dans mon message (âgé de plus de 20 jours) N° 329
Le test qui y est proposé est simple et sa finalité est de placer le seul curseur et d'examiner si sa position est correcte ou non dans tous les cas, notamment avec aero, avec et sans zoom etc ...

Ne pas oublier d'ajouter dans la partie déclarative :

Code :

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

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

C'est en éliminant ainsi le placement de l'userform et en n'examinant que le seul résultat de ce code, que l'on saura de manière indubitable si la méthode PointstoScreenPixelsX/Y connaît ou non une faille.
C'est Cela, que j'appelle "sérier". Et cela permet d'éviter de s'interroger sur la responsabilité éventuelle de tel ou tel élément lorsque plusieurs éléments entrent en jeu en même temps. Ce n'est qu'en mettant en jeu UN SEUL élément à la fois que l'on peut déterminer s'il est, LUI, fautif ou non.

EDIT : Le test que je proposais en mon message 329 est tel qu'il permet une meilleure estimation visuelle (curseur en forme de flèche dont la pointe montre mieux le placement que ne le fait la forme du curseur lorsqu'il est sur une cellule)

[pijaku]

Je pensais cette histoire avec la méthode PointstoScreenPixelsX/Y résolue!

La méthode PointstoScreenPixelsX/Y déconne, n'en déplaise à Patrick.

Ton test Jacques, je l'avais réalisé et... ça déconnait.

Pourquoi cela déconne chez certains et pas chez d'autres ?
Vous voulez l'explication ?
Je vous ai donné un indice, aujourd'hui à 15h17...

En fait, dans la grille d'excel, telle qu'elle est construite "à la base" (nouvelle feuille), la méthode PointstoScreenPixelsX/Y ne se trompe jamais!
C'est à penser que les gens de Microsoft l'on créée exprès avec ces caractéristiques la, juste pour faire fonctionner la méthode PointstoScreenPixelsX/Y...

Par contre, dès que l'on fait varier la hauteur d'une ligne ou la largeur d'une colonne, à un moment donné, ça plante.
N'essayez pas de faire des tests "manuellement", vous risquez fort de tomber systématiquement sur une taille qui "fonctionne".

Par contre, testez via une macro en faisant un "truc" du style :

Code :

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

1
2
3
4
5
6
7
8
9
'écrit sur le forum donc pas forcément fiable
Sub testHauteurLigne()
Dim i&
For i = 1 to 100
    Rows(5).RowHeight = Rows(5).RowHeight + 0.5
    'test de la méthode PointstoScreenPixelsX/Y sur A5 et A6
    'imaginez le test que vous voulez, ça déconnera à un moment...
Next i
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
'écrit sur le forum donc pas forcément fiable
Sub testLargeurColonne()
Dim i&
For i = 1 to 100
    Columns(5).ColumnWidth = Columns(5).ColumnWidth + 1
    'test de la méthode PointstoScreenPixelsX sur E2 et F2
    'imaginez le test que vous voulez, ça déconnera à un moment...
Next i
End Sub

Et c'est uniquement cette absence de test de Patrick qui fait que l'on ne sait toujours pas si la méthode PointstoScreenPixelsX/Y déconne ou pas.

Stp, Patrick, essaye.... Teste en variant les hauteurs de lignes et de colonnes...


A propos de test, Jacques, est ce que ce test te paraitrait concluant?

Code :

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

1
2
3
4
5
6
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)
        If wactievcell <> w2 Then MsgBox "la méthode PointstoScreenPixelsX/Y déconne"
End With

ou pas...
C'est Patrick qui le proposait cette après midi.

Bonne réflexion à toutes et tous!

EDIT : Jacques, lorsque tu parles de sérier, dans mes fonctions, si tu avais pu tester, tu aurais bien vu que je séparais (depuis le début) l'utilisation de la méthode PointstoScreenPixelsX/Y de celle de dmw.
Du coup, ce qui déconnais était évident...

EDIT2 : pour être tout à fait clair...
MES TESTS tendent à prouver que la méthode PointstoScreenPixelsX/Y ne déconne en aucun cas sur une "grille excel neuve". Quel que soient le zoom, le dpi ou autre.
Mais, je le reconnais, ce ne sont que MES tests et ceux-ci peuvent (au vu de mon manque de connaissances) être défaillants...

[patricktoulon]

depuis un moment tout le monde a compris que pour capter le décalage entre autre il fallait les api (dwm,ect)

@jacques le seul résultat que tu a eu de "ajust" c'est celui de pijaku , ca me parait sans vouloir offenser personne de prendre ce résultat pour exact a 100% surtout que le disant lui même (avec démo en plus) la fonction pointstoscreenpixel a l'air de dérailler chez lui


pour ma part
je constate que :
en 96 dpi et sans aero !!! rien!!! queudale!!! visuellement c'est parfait je n'ajoute rien ,je n'enlève rien , attention je dis bien visuellement car en vérité il n'en est rien mathématiquement parlant mais les nuances sont si petites que vba arrondi

aero et theme W10
on constate un décalage sur W7 identique pour le top et left
pour Windows 10 c'est la débandade on a aucun repère aucun n'a le même décalage avec le thème W10 original

dpi 96 / 120
alors la on constate un ecart sur certaines colonnes (qui en plus!!varie en pourcentage) selon le zoom

j'était curieux de trouver le moyen de tester la différence visuellement et mathématiquement sans userform et sans api
tu me diras c'est facile pointstoscreenpixel ramené en points et c'est bon oui sauf que le résultat est bon mathématiquement (dommage)

alors pour en avoir le cœur net j'utilise non pas les api, non pas un userform

juste une shape !!!

pourquoi?

parce que la on a tout les outils de:
sheets(x).shapes
c'eux de l application
c'eux de l'activewindow
bref tout ce que l'on peut pas faire avec un userform sans api

j'ai simplement fait une petite sub
qui place le shape avec pointstoscreenpixel
dans le quel j'incrit le topleftcell(ici déjà on a la réponse a ta question )

j'inscrit les données left par ptoscpix et celle de left cellule
je fait meme la soustraction

et c'est la que l'on vois vraiment que AUCUNE CELLULE NE CORRESPONT A P....TOSC....PIXTLS

ALORS TON PREMIER REFLEXE SERA DE ME DIRE TU TE CONTREDI alors !!!!!!

MOI JE DIS NON!!

car une chose est sur: a pointstoscreenpixels est injecté quoi!!!!!????? ACTIVECELl.TOP OU LEFT !!!!!!!!!

bref pour ne pas trop romancer et aller a l'essentiel de mon point de vue tu en fera ce que tu voudras

voici ce petit code je me suis contenter de faire que pour le left pour le top faire pareil

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
[Sub testshape()
 With ActiveWindow
       With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
     x = ((1 + .ActivePane.PointsToScreenPixelsX(ActiveCell.Left) - .ActivePane.PointsToScreenPixelsX(0)) / ppx) / (.Zoom / 100)
 
        y = ((.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)
    Set shap = ActiveSheet.Shapes.AddShape(1, x, y, 70, 120)
 
     texte = "topleftcell " & shap.TopLeftCell.Address & vbCrLf
     texte = texte & "ActiveCell.Left " & ActiveCell.Left & vbCrLf
     texte = texte & " pttoscreenpixX " & x
     texte = texte & " diff left " & x - ActiveCell.Left
     shap.TextFrame.Characters.Text = texte
   shap.TextFrame.Characters.Font.Size = 6
   shap.Line.Weight = 3
    End With
End Sub

voila dans le shape tu devrait avoir leur différence individuelles

fait le test sur toute les cellule d'une même ligne et regarde bien les ecarts
tu peut faire aussi le test sur des cellules eloignées en terme de colonnes et de lignes et (bien regarder la bordure

voila

apres faut pas déconner on a bien bossé quand même
mais peut etre que si tu t'interesse ames shapes tu va nous trouver la solution sans api hein !!??? je dis ca je dis rien moi
et pour ilustrer ce que je dis


dpi 120 thème aero désactivé
et la déjà en regardant simplement les bordures verticales on a compris

[unparia]

Ne mélange pas les genres, Patrick

déjà en regardant simplement les bordures verticales on a compris

1) Une Shape n'est pas un userform (dont la hauteur comprend les bordures)
2) les bordures d'une Shape viennent s'ajouter autour de la Shape. Elle n'en font pas partie et ne modifient en aucun cas les dimensions de la Shape elle-même
Il suffit de peindre la shape en rouge pour voir que tu as d'une part la shape et d'autre part ses bordures
Or, tu as mis des bordures (de 3, en plus)
3) tu aurais le même effet et les mêmes "occupations" en donnant directement x et y les coordonnées de la cellule (sans PointstoscreenpixelsX/Y)
Preuve de tout cela

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
With ActiveWindow
       With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
     '<s>x = ((1 + .ActivePane.PointsToScreenPixelsX(ActiveCell.Left) - .ActivePane.PointsToScreenPixelsX(0)) / ppx) / (.Zoom / 100)</s>
     x = ActiveCell.Left
     ' <s>   y = ((.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)</s>
     y = ActiveCell.Top
     Set shap = ActiveSheet.Shapes.AddShape(1, x, y, 70, 120)
 
     texte = "topleftcell " & shap.TopLeftCell.Address & vbCrLf
     texte = texte & "ActiveCell.Left " & ActiveCell.Left & vbCrLf
     texte = texte & " pttoscreenpixX " & x
     texte = texte & " diff left " & x - ActiveCell.Left
     shap.TextFrame.Characters.Text = texte
     shap.TextFrame.Characters.Font.Size = 8
     shap.Line.Weight = 3
     shap.Fill.ForeColor.RGB = RGB(255, 0, 0)
 
    End With

Quant aux coordonnées retournées par PointstoscreenpixelsX/Y, elle le sont par rapport à l'écran. Celles des shapes le sont par rapport à ActiveWindow.

Lu dans l'aide pour let, par exemple :

Left : Cette propriété renvoie ou définit une valeur de type Single qui représente la distance en points entre le bord gauche de l'objet et le bord gauche de colonne A (d'une feuille de calcul) ou le bord gauche de la zone de graphique (dans un graphique).

Je vais quant à moi t'apporter la preuve contraire -->> pourquoi passer par une shape, avec les risques induits de "pollution" dus à la shape, ses bordures et son placement ?-->> pas la peine --->>

Code :

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

1
2
3
4
5
With ActiveWindow
      With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
      y = ((.ActivePane.PointsToScreenPixelsY(Range("B4").Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)
      MsgBox Range("B1:B3").Height & "   " & y
  End With

[pijaku]

Bonjour,

Pourriez-vous relire mon message 1008 d'hier soir?

Je viens de tester (à nouveau) avec ces codes :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
 
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
 
Sub Test_PointsToScreenPixelsZOOM()
Dim i&, cible As Range
 
For i = 50 To 400 Step 20
    ActiveWindow.Zoom = i
    Set cible = Range("B4")
    With Label1
      .Caption = ""
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
    End With
    With TextBox1
      .Top = cible.Offset(1, 0).Top
      .Left = cible.Left
      .BackColor = RGB(255, 255, 255)
     .Text = ActiveWindow.Zoom & "   " & (ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left) - ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Left)) / cible.Width
    End With
    With ActiveWindow.ActivePane
        SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top)
    End With
    Stop
Next
End Sub
 
Sub Test_PointsToScreenPixelsHAUTEUR()
Dim i&, cible As Range, HauteurInitiale As Single
HauteurInitiale = Rows(3).RowHeight
    ActiveWindow.Zoom = 300
For i = 1 To 100
    Rows(3).RowHeight = Rows(3).RowHeight + 0.5
    Set cible = Range("B4")
    With Label1
      .Caption = ""
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
    End With
    With TextBox1
      .Top = cible.Offset(1, 0).Top
      .Left = cible.Left
      .BackColor = RGB(255, 255, 255)
     .Text = ActiveWindow.Zoom & "   " & (ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left) - ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Left)) / cible.Width
    End With
    With ActiveWindow.ActivePane
        SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top)
    End With
    Stop
Next
Rows(3).RowHeight = HauteurInitiale
    ActiveWindow.Zoom = 100
End Sub
 
Sub Test_PointsToScreenPixelsLARGEUR()
Dim i&, cible As Range, LargeurInitiale As Single
 
LargeurInitiale = Columns(1).ColumnWidth
    ActiveWindow.Zoom = 300
For i = 1 To 100
    Columns(1).ColumnWidth = Columns(1).ColumnWidth + 1
    Set cible = Range("B4")
    With Label1
      .Caption = ""
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
    End With
    With TextBox1
      .Top = cible.Offset(1, 0).Top
      .Left = cible.Left
      .BackColor = RGB(255, 255, 255)
     .Text = ActiveWindow.Zoom & "   " & (ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left) - ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Left)) / cible.Width
    End With
    With ActiveWindow.ActivePane
        SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top)
    End With
    Stop
Next
Columns(1).ColumnWidth = LargeurInitiale
    ActiveWindow.Zoom = 100
End Sub

Conclusion :

1. Le zoom ne change en rien la position du curseur
2. La hauteur de ligne fait que le curseur n'est pas bien positionné par moment (ce n'est pas systématique)
3. Idem pour la largeur de colonne

Peut-on en conclure que la méthode .PointsToScreenPixels ne fonctionne pas correctement?

Je reviens...

Mêmes conclusions en 96 et 120 DPI (Normal!)

EDIT : de retour!
Par contre, sur une feuille neuve, aucun souci avec PointsToScreenPixels...

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
Sub Test_PointsToScreenPixelsSurFeuilleNeuve()
Dim C, cible As Range, LargeurInitiale As Single
 
For Each C In ActiveWindow.VisibleRange
    Set cible = C
    With Label1
      .Caption = ""
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
    End With
    With TextBox1
      .Top = cible.Offset(1, 0).Top
      .Left = cible.Left
      .BackColor = RGB(255, 255, 255)
    .Text = ActiveWindow.Zoom & "  Left : " & ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Left) & "  " & " Top : " & ActiveWindow.ActivePane.PointsToScreenPixelsY(cible.Top)
    End With
    With ActiveWindow.ActivePane
        SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top)
    End With
    Stop
Next
End Sub

EDIT2 : essayez cette macro plusieurs fois d'affilé (il s'agit du test de Jacques de cette nuit)...

Code :

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

1
2
3
4
5
6
7
8
Sub unparia1010()
    With ActiveWindow
        Rows(2).RowHeight = Rows(2).RowHeight + 0.25
        With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
        y = ((.ActivePane.PointsToScreenPixelsY(Range("B4").Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)
        MsgBox Range("B1:B3").Height = y
    End With
End Sub

[unparia]

Bonjour Franck

Dès mon retour de la pêche, je mettrai ici une démonstration très nette (faite ce matin) d'une faille de la méthode pointstoscreenpixels

[patricktoulon]

ok j'attend ta demo

mais pour ma démo c'est voulu la bordure c'était pour démontrer la même chose que pour l'userform et le topleftcell parle pour moi
quand tu fait userform1.left =x

vba compte x sans le rajout d'un éventuel thème

ensuite pointstoscreenpixel a une faille ?
je sais pas trop tu va certainement nous le montrer perso je vois pas

en terme mathematique calcul pure je peux te dire oui mais en terme d utilisation je te dis non

depuis un moment déjà comme je te l'ai dis pointstoscreenpixel est adapté a la deformation de l'effet zoom par le zoom excel ou par le dpi en l'occurrence le 120 qui grossi les surface mais change les proprortions


pour te donner vraiment un aperçu réel de mon point de vue
voici deux macro toutes simples

dans la premiere il est nullement question de conversion que ce soit simplement activecell pour placer la cellule

l'autre utilise ma formule que tu déteste tant et j'ai mis en commentaire la ligne ppx par le registre

j'utilise 2 cellules d'une même colonne et place une shape identique avec les deux macro

demo avec ppx par ppx du registre selon le dpi au dessus et coeeficient ppx par pointtoscreenpixel en dessous le résultat s'inscrit dans le shape il est plus que parlant
la shape du dessous est posé avec simplement activecell sans calcul

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
Sub testshape()
 With ActiveWindow
       Z = (.Zoom / 100)
      ' With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
 
     ppx = (.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) - .ActivePane.PointsToScreenPixelsX(0)) / (ActiveCell.Left * Z)
      x = ((.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) - .ActivePane.PointsToScreenPixelsX(0)) / ppx) / (.Zoom / 100)
 
      'x = ((.ActivePane.PointsToScreenPixelsX(Range(Cells(1, 1), ActiveCell.Offset(0, -1)).Width) - .ActivePane.PointsToScreenPixelsX(0)) / ppx) / Z
 
        y = ((.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)
    Set shap = ActiveSheet.Shapes.AddShape(1, x, y, 70, 120)
 
     texte = "topleftcell " & shap.TopLeftCell.Address & vbCrLf
     texte = texte & "ActiveCell.Left " & ActiveCell.Left & vbCrLf
     texte = texte & " pttoscreenpixX " & x
     texte = texte & " diff left " & x - ActiveCell.Left
     shap.TextFrame.Characters.Text = texte
   shap.TextFrame.Characters.Font.Size = 6
   shap.Line.Weight = 3
    End With
End Sub
Sub testuneshape()
 Set shap = ActiveSheet.Shapes.AddShape(1, ActiveCell.Left, ActiveCell.Top, 70, 120)
 
       shap.TextFrame.Characters.Text = texte
   shap.TextFrame.Characters.Font.Size = 6
   shap.Line.Weight = 3
MsgBox ActiveCell.Left
End Sub

tu n'a qu'a faire le teste toi même tu verra simplement en bloquant la ligne ppx (l'une ou l'autre)

si je puis m'exprimer ainsi en fait toute les données de l'Operations sont fausses quand on utilise une valeur externe a excel en ce qui concerne l'affichage

ppx registre ou api faux
zoom faux car l'affichage est déformé et ne correspond pas proportionnellement a ce qui est affiché en mode aero d'abord puis en dpi 120 c'est pire
en gros pour faire simple
quand tu vois ta fenêtre Excel dans ton écran tu vois une représentation approximative de ce qui est
tout est modifié avec le theme ou le dpi ( je dis bien tout)
la preuve c'est qu'en désactivant tout c'est nikel avec les même calcul avec pointstoscreenpixels que aime tant

et pour la différence avec W10 qui lui donne plus loin toujours !!

vous avec qu'a vous demander pourquoi sur cette version de Window ils ont laissé DWM qui dans cette version de modifie que l'intérieur de la caption et cadre ,vous aurez votre réponse

je te le démontre quand tu veux

[unparia]

ensuite pointstoscreenpixel a une faille ?
je sais pas trop tu va certainement nous le montrer perso je vois pas

en terme mathematique calcul pure je peux te dire oui mais en terme d utilisation je te dis non

Et comment qu'il a une faille! Et tu la verras, mathématiquement ET visuellement. Y compris sans zoom, sans aero et sous XP. Juste en plaçant le curseur par setcursorpos aux coordonnées calculées par PointsToScreenPixelsX/Y
Je dois sortir, puis me reposer. Il me faut agrémenter la demo de messages. J'essaierai également de donner mon explication de la faille sporadique (dépend des dimensions données aux cellules).
J'essaierai ensuite (plus tard) de contrecarrer cette faille, mais ne sais pas si j'y parviendrai (si ce que je pense est vrai, ce sera assez difficile, voire impossible depuis l'extérieur du code que gère PointsToScreenPixelsX/Y)

[pijaku]

Bonjour,

ça me semble compliqué.
D'autant que SetCursorPos travaille avec des entiers et non des décimaux.

Par exemple :

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
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Sub test()
Dim pos As POINTAPI, ppx as double
   ppx = 4/3 'ou 5/3 pour DPI 120
   pos.X = 0
With ActiveWindow.ActivePane
   pos.Y = (.PointsToScreenPixelsY(5) - .PointsToScreenPixelsY(0)) / ppx
End With
'ICI pos.Y = 5, mais (.PointsToScreenPixelsY(5) - .PointsToScreenPixelsY(0)) / ppx = 5,25
   SetCursorPos pos.X, pos.Y '=> positionnement du curseur aux coordonnées X = 0, Y = 5
End Sub

Enfin, je ne souhaite pas aller trop vite et j'attends ton retour.

[unparia]

Bon.
Le voilà, le test en question .
Il met très clairement en exergue la carence de PointsToScreenPixels confronté à certaines dimensions de cellules
Dans ce test (où tout est pourtant simple ... ni aero, ni zoom) : se plantera (décalage) avec la cellule D11. Et très curieusement : sera de nouveau précis avec la cellule D14 !
Pour tester :
- une feuille avec un bouton de commande commandbutton1 et un label Label1

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
34
35
36
37
38
39
40
Private Sub CommandButton1_Click()
  Range("A1:A20").RowHeight = 15 '| voilà un exemple de cellules posant problème
  Range("A10").RowHeight = 64.5
  Columns(2).ColumnWidth = 10
  DoEvents
  With CreateObject("WScript.Shell")
     ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
  End With
  With ActiveWindow
    y = ((.ActivePane.PointsToScreenPixelsY(Range("D14").Top) - .ActivePane.PointsToScreenPixelsY(0)) / ppx) / (.Zoom / 100)
    MsgBox Range("D1:D13").Height & vbCrLf & y & vbCrLf & "écart : " & Range("D1:D13").Height - y & vbCrLf & _
    "pointstoscreenpixelsX s'est planté dans cette configuration de hauteurs de cellules !" & vbCrLf & _
    "Faisons maintenant le test de mon message 329 d'il y a 20 jours" & vbCrLf & vbCrLf & _
    "Nous allons demander que le curseur se place en cellule D11 (et nous observerons un décalage)" & vbCrLf & _
    "puis en cellule D14 (et étrangement : plus de décalage !) "
    BlockInput True
    Set cible = Range("D11")
    DoEvents
    With Label1
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
      .Width = 400
    End With
    With ActiveWindow.ActivePane
      SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top) ' REGARDER LE DECALAGE !
    End With
    Application.Wait Now + TimeValue("0:00:05") ' attente pour donner le temps de voir
    Set cible = Range("D14")
    With Label1
      .Top = cible.Top
      .Left = cible.Left
      .BackColor = RGB(255, 200, 200)
    End With
    With ActiveWindow.ActivePane
      SetCursorPos .PointsToScreenPixelsX(cible.Left), .PointsToScreenPixelsY(cible.Top)
    End With
    BlockInput False ' --->> je réhabilité souris et clavier
  End With
End Sub

Et (à l'attention de Patrick) : ce code ne fait appel qu'à la méthode PointstoScreenPixels (SACREMENT MISE EN CAUSE) et à la fonction SetCursorPos (qui ne saurait être mise en cause).

Ce que je "devine" : PointstoScreenPixels est en défaut lorsque l'une (ou les deux) des deux coordonnées de la cellule cible (en points au départ), une fois convertie(s) en pixels, ne sont pas un nombre entier de pixels. Il semble qu'ait été passé aux oubliettes un calcul d'ajustement rendu alors nécessaire (du genre de celui que j'ai montré dans un message précédent pour le placement de userforms).

Ce ne sera que ce soir que je me mettrai à tenter de corriger depuis l'extérieur (pas facile et sans aucune certitude de résussite).

Alors, Patrick ? Coupable ou pas coupable, la méthode PointsToScreenPixels .
Elle est seule à être ici utilisée ...

[pijaku]

Je confirme.

Attention toutefois à :

Code :

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

BlockInput

N'existe pas.
J'ai juste commenté les 2 lignes.

[unparia]

Salut Franck
J'ai juste oublié de tout copier/coller

Dans la partie déclarative :

Code :

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

1
2
3
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
 
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

J'ai ajouté la fonction BlockInput pour éviter les conséquences de tout mouvement mal contrôlé de la main sur la souris . Le test est plus sûr ainsi.

Par ailleurs : les essais que je suis en train de faire pour "corriger depuis l'extérieur" m'effraient. Si mon essai de correction (efficace) est toujours vrai, le code de la méthode PointsToScreenPixels est alors vraiment honteux, voire carrément scandaleux !
Je reviendrai en parler plus tard.

EDIT : j'avance avec encore plus de certitude et c'est encore pire : conjugaison de deux facteurs : l'un dû à un aspect caché de Excel, l'autre à une ignorance de cet aspect par la méthode PointsToScreenPixels. C'est un comble et un "kilombo" (salut au passage au Porteño s'il passe par là ) total !

[patricktoulon]

Je regarde ca en rentrant mais le peu que j ai vu sur le smart phone me mpntre que vous avez pas compris ce que j ai dis plus haut
Il faut banir votre ppx il est pas bon!!!!!!
Mais je regarderais plus en detail ton travail toute a l heure quans je rentre

[patricktoulon]

re
bon me voila de retour

jacques j'ai testé ton code
j'ai simplement mis en commentaire blockinput et ajouter" activesheet." devant label1

j'ai une question
qu'a tu voulu me démontrer????????? la il faut m'expliquer

chez moi c'est nikel
je ne peut rien te dire de plus je vais examiner le code que tu a produit mais je vois pas ce que je peut faire
et pourtant je suis dans les plus mauvaise conditions (aero et dpi 120)
j'ai testé sur un fichier vierge

démo en image




je t'en prie fait quelque chose avec ton XP