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)
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)
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
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.
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)
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.
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é
après si je prends la calculette
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
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
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 :
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.
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 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)
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 SubEt 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.
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
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?
ou pas...
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
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...
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
voila dans le shape tu devrait avoir leur différence individuelles
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
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
Ne mélange pas les genres, Patrick
1) Une Shape n'est pas un userform (dont la hauteur comprend les bordures)déjà en regardant simplement les bordures verticales on a compris
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
Quant aux coordonnées retournées par PointstoscreenpixelsX/Y, elle le sont par rapport à l'écran. Celles des shapes le sont par rapport à ActiveWindow.
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
Lu dans l'aide pour let, par exemple :
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 --->>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).
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
Bonjour,
Pourriez-vous relire mon message 1008 d'hier soir?
Je viens de tester (à nouveau) avec ces codes :
Conclusion :
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
- Le zoom ne change en rien la position du curseur
- La hauteur de ligne fait que le curseur n'est pas bien positionné par moment (ce n'est pas systématique)
- 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...
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
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
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
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
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
tu n'a qu'a faire le teste toi même tu verra simplement en bloquant la ligne ppx (l'une ou l'autre)
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
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
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/Yensuite 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
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)
Bonjour,
ça me semble compliqué.
D'autant que SetCursorPos travaille avec des entiers et non des décimaux.
Par exemple :
Enfin, je ne souhaite pas aller trop vite et j'attends ton retour.
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
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
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).
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
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 ...
Je confirme.
Attention toutefois à :
N'existe pas.
Code : Sélectionner tout - Visualiser dans une fenêtre à part BlockInput
J'ai juste commenté les 2 lignes.
Salut Franck
J'ai juste oublié de tout copier/coller
Dans la partie déclarative :
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.
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
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 !
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
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager