bonjour,
j'avais posté une "anim" sur le décalage de ligne ICI Page 33 #655
W10 e10
@+JP
bonjour,
j'avais posté une "anim" sur le décalage de ligne ICI Page 33 #655
W10 e10
@+JP
A Franck
Ce ne sera pas une supposition, mais bel et bien une preuve.Oui...
Mais depuis le début de cette discussion, on ne peux émettre que des suppositions...
Je suis trop fatigué pour en faire la démonstration totale (je la ferai demain), mais commence par ce tout petit constat :
EN MODE CREATION :
crée donc un userform et donne-lui ces propriétés (en mode création) :
Left = 100
Height = 100
Top = 400
Width = 100
Elles paraissent acceptées, n'est-ce pas ?
Lance maintenant l'application et exécute cette instruction :
Userform1.show
ferme le userform et retourne en mode création :
Réexamine maintenant les propriétés Top, Left, width et height -->> sans commentaires (VBA les a seulement alors corrigées)
La suite pour demain...
Jacques, si je pouvais te mettre +1000 je le ferais.
Mais, ce comportement, tout le monde en avait conscience, sans s'en rendre compte...
Je l'ai observé sur tout les UserForm que j'ai créé, ... sans me poser la vraie question : "pourquoi cette modification".
A vrai dire, des modifications de l'ordre de 0.25 à 0.75 pts ne m'ont jamais dérangé dans les fichiers que je créais...
Je pense qu'il faudrait ré-examiner le problème à la source : positionner le curseur de la souris par rapport à l'écran, et surtout par rapport à une cellule Excel (coin supérieur gauche).
Oublions un instant cet UserForm qui nous (vous) prend la tête en faisant des siennes lors de son affichage, juste pour voir...
Si l'on parvient à positionner le curseur sur le coin supérieur gauche d'une cellule, pour moi tout sera gagné.
On pourra éventuellement réfléchir (et il faudra absolument que cela fasse l'objet d'une autre discussion (on ne comprend plus rien à celle ci)) au positionnement de l'UserForm selon les "défauts" que tu soulignes ce soir....
Bises à tous
Amitiés à toi Jacques.
ps : bien entendu mon point de vue ne concerne que ma "petite" vision des choses.
N'oubliez pas, toutes et tous, que je n'y connais pas grand chose dans tout cela...
Ciao!!
![]()
A Franck :
Je n'ai pas zappé cette partie de ton message.Peut-être est-t'il temps de faire appel à d'autres langages de programmation.
Je penses notamment à VB.Net.
Quitte à paraître une fois de plus stupide, ne peux t'on pas demander à quelqu'un maîtrisant ce langage (whismeril me semble judicieux...) de :
tester la coordonnées dans l'écran d'un point quelconque,
de tester (en se référant à Excel) ce même point avec la méthode pointtoscreenpixel
de réaliser un autre test qui ne me vient pas parce que je n'y connais rien...
Mais rechercher mes propres messages dans maintenant 49 pages et parmi ... 963 messages n'est pas chose aisée (quel capharnaüm !)
C'est exactement ce qui a été entrepris ailleurs (du moins presque exactement car nous avons fait mieux encore : placer un pixel sur l'écran à des coordonnées spécifiées et donc connues, puis travailler sur cette base). Et cela a été fait à l'aide de langages différents (y compris VB6)
Relis mes messages 401, 403 et 416.
A demain ...
le calcul tu l'a dans le code je récupère seulement le width -insidewidth +2@ Patrick :
C'est bien, mais comment calcule tu ton "plus"??????
on voit bien la différence avec ou sans aero
jacques j'aurais cru que tu le savais déjà
quand tu change dynamiquement par vba ses propriétés s'inscrive dans le vbe
Patience Patrick, patience ...
Tu auras demain tout ce qui convient, comme dans la chanson "vous saurez tout sur le zizi" (et tu verras comment, et tu sauras pourquoi)
Ne t'emballe pas pour rien.
Et je me moquerai comme de l'an 14 de ce qui "s'inscrit dans le VBE"
De bon matin et reposé : revenons à ce qu'exposait mon message #962 --->>
Nous avons vu qu'étaient corrigées les valeurs saisies des 4 propriétés Left, Width, Top et Width.
Question : quelle en est donc la raison ?
Réponse : La raison en est que toutes les interventions graphiques sont forcément faites en échelle de pixels même si pour des raisons qui sont d'unicité et/ou de convivialité, VBA a choisi de travailler sur une échelle de points.
Or, une valeur exprimée en points ne correspond pas obligatoirement à un nombre entier de pixels. Que faire alors de la partie décimale de cette correspondance en pixels, puisqu'elle ne saurait être affichée, le pixel étant l'unité graphique affichable la plus petite ?
Il faut alors bien évidemment corriger la valeur d'origine. Et la correction est faite de cette manière :
Valeur d'origine -->> correspondance théorique en pixels --->> arrondissement à l'entier le plus proche --->> correspondance de cette dernière valeur en échelle de points.
Ce mécanisme étant maintenant bien compris, voici la fonction VBA qui le traduirait.
Dans cette fonction, pixparpoint est le nombre de pixels par point (que nous savons calculer).Pour ne pas encomprer ici, nous allons supposer que nous avons déterminé sa valeur et qu'elle est 1.333333 (pour un dpi de 96, donc) et v est le nombre d'unités en points à ajuster :
Exemple d'appel :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Private Function ajuste(v As Single) As Single pixparpoint = 1.333333 '---->> si 96 dpi -->> adapter à votre dpi v = v * pixparpoint ' --->> nb décimal de pixels ajuste = WorksheetFunction.Round(v, 0) ' --->> nb entier de pixels le plus proche ajuste = WorksheetFunction.Round(ajuste / pixparpoint, 2) ' ---> nb "ajusté" de points End Function
Faites des essais à comparer avec les résultats en agissant comme en mon message 962 -->> toujours bon.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Dim toto As Single toto = ajuste(400) MsgBox toto
Revenons maintenant à notre test. Nous y affections dynamiquement des valeurs de propriétés de l'userform. Il nous faut dès lors les corriger par notre fonction.
Ainsi (exemple bâclé avec XP sans aero ) :
Voilà ... je vous laisse maintenant utiliser tout cela dans le code complet du sujet principal
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 Private Sub CommandButton1_Click() With UserForm1 .Top = 400 .Left = 100 .Width = 100 .Height = 100 .Show 0 .Show 0 End With With UserForm2 .Top = ajuste(UserForm1.Top) .Left = ajuste(UserForm1.Left) + ajuste(UserForm1.Width) .Show 0 MsgBox "nous sommes en accolement horizontal " .Left = ajuste(UserForm1.Left) .Top = ajuste(UserForm1.Top) + ajuste(UserForm1.Height) .Show 0 MsgBox "nous sommes en accolement vertical " .Top = ajuste(UserForm1.Top) + ajuste(UserForm1.Height) .Left = ajuste(UserForm1.Left) + ajuste(UserForm1.Width) .Show 0 MsgBox "voilà ce que nous voulions" End With End Sub
Bonjour,
Patrick :
Désolé, je n'avais pas les yeux en face des trous.
Par contre, le + 2 est une variable d'ajustement?
Jacques,
Voici le code utilisé hier :
Si l'on dé-commente les 3 lignes, on obtient :
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 Option Explicit Private Declare Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Enum DWMWINDOWATTRIBUTE DWMWA_NCRENDERING_ENABLED = 1 DWMWA_NCRENDERING_POLICY DWMWA_TRANSITIONS_FORCEDISABLED DWMWA_ALLOW_NCPAINT DWMWA_CAPTION_BUTTON_BOUNDS DWMWA_NONCLIENT_RTL_LAYOUT DWMWA_FORCE_ICONIC_REPRESENTATION DWMWA_FLIP3D_POLICY DWMWA_EXTENDED_FRAME_BOUNDS DWMWA_LAST End Enum Private Sub CommandButton1_Click() With UserForm1 .Top = 100 .Left = 100 .Width = 200 .Height = 200 .Show 0 End With placer_userform2 End Sub Private Sub placer_userform2() Dim mUsf1 As RECT, mUsf2 As RECT mUsf1 = Correction(UserForm1) With UserForm2 .Top = UserForm1.Top + UserForm1.Height + mUsf1.Top .Left = UserForm1.Left + UserForm1.Width + mUsf1.Left .Show 0 'mUsf2 = Correction(UserForm2) '.Top = .Top + mUsf2.Top '.Left = .Left + mUsf2.Left .Width = 200 .Height = 200 End With End Sub Private Function Correction(Usf As Object) As RECT Dim DblPpx As Double Dim LngResult As Long, LngHwnd As Long With CreateObject("WScript.Shell") DblPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / Application.InchesToPoints(1) End With LngHwnd = FindWindow(vbNullString, Usf.Caption) LngResult = DwmGetWindowAttribute(LngHwnd, DWMWA_EXTENDED_FRAME_BOUNDS, Correction, LenB(Correction)) If Correction.Left <> 0 Then Correction.Left = Usf.Left - (Correction.Left / DblPpx) Correction.Top = Usf.Top - (Correction.Top / DblPpx) End If End Function
Pièce jointe 295518
Bonjour Franck
Applique ce que j'ai exposé dans mon message précédent et le petit décalage encore perceptible devrait totalement disparaître.
EDIT : et fais gaffe à ne pas te laisser tenter à "simplifier" les lignes du genre :
Car l'arrondi d'un total n'est pas égal à la somme des arrondis
Code : Sélectionner tout - Visualiser dans une fenêtre à part .Left = ajuste(UserForm1.Left) + ajuste(UserForm1.Width)
Bon...
Pas sur d'avoir bien fait...
Voici le code :
Et les résultats :
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 Option Explicit Private Declare Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Enum DWMWINDOWATTRIBUTE DWMWA_NCRENDERING_ENABLED = 1 DWMWA_NCRENDERING_POLICY DWMWA_TRANSITIONS_FORCEDISABLED DWMWA_ALLOW_NCPAINT DWMWA_CAPTION_BUTTON_BOUNDS DWMWA_NONCLIENT_RTL_LAYOUT DWMWA_FORCE_ICONIC_REPRESENTATION DWMWA_FLIP3D_POLICY DWMWA_EXTENDED_FRAME_BOUNDS DWMWA_LAST End Enum Private Sub CommandButton1_Click() Dim mUsf1 As RECT, mUsf2 As RECT With UserForm1 .Top = 400 .Left = 100 .Width = 100 .Height = 100 .Show 0 .Show 0 End With mUsf1 = Correction(UserForm1) With UserForm2 .Top = 0 .Left = 0 mUsf2 = Correction(UserForm2) .Top = ajuste(UserForm1.Top) .Left = ajuste(UserForm1.Left + UserForm1.Width + mUsf1.Left + mUsf2.Left) .Show 0 MsgBox "nous sommes en accolement horizontal " .Left = ajuste(UserForm1.Left) .Top = ajuste(UserForm1.Top + UserForm1.Height + mUsf1.Top + mUsf2.Top) .Show 0 MsgBox "nous sommes en accolement vertical " .Top = ajuste(UserForm1.Top + UserForm1.Height + mUsf1.Top + mUsf2.Top) .Left = ajuste(UserForm1.Left + UserForm1.Width + mUsf1.Left + mUsf2.Left) .Show 0 MsgBox "voilà ce que nous voulions" End With End Sub Private Function ajuste(v As Single) As Single Dim pixparpoint# pixparpoint = 1.333333 '---->> si 96 dpi -->> adapter à votre dpi v = v * pixparpoint ' --->> nb décimal de pixels ajuste = WorksheetFunction.Round(v, 0) ' --->> nb entier de pixels le plus proche ajuste = WorksheetFunction.Round(ajuste / pixparpoint, 2) ' ---> nb "ajusté" de points End Function Private Function Correction(Usf As Object) As RECT Dim DblPpx As Double Dim LngResult As Long, LngHwnd As Long With CreateObject("WScript.Shell") DblPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / Application.InchesToPoints(1) End With LngHwnd = FindWindow(vbNullString, Usf.Caption) LngResult = DwmGetWindowAttribute(LngHwnd, DWMWA_EXTENDED_FRAME_BOUNDS, Correction, LenB(Correction)) If Correction.Left <> 0 Then Correction.Left = Usf.Left - (Correction.Left / DblPpx) Correction.Top = Usf.Top - (Correction.Top / DblPpx) End If End Function
Accolement horizontal :
Pièce jointe 295519
Accolement vertical :
Pièce jointe 295521
Ce que nous voulions :
Pièce jointe 295524
Excellent, Franck
Plus de décalage du tout, y compris avec aero
Voilà une excellente nouvelle
NOTE : L'idée maîtresse est celle d'un membre d'une équipe tierce, que je salue (il comprend suffisamment le français et nous lit).
Seuls l'exploitation de cette idée et les calculs induits sont de mon cru.
Bonjour,
J'ai essayé le code de Franck sur mon poste, sa ne marche pas de mon côté. Le problème vient sûrement du fait que je sois en affichages multiples.
Dernière modification par Invité ; 20/07/2017 à 09h12.
Avec le code :
en DPI = 120, zoom 260% (juste pour mieux distinguer), j'obtiens un léger décalage (marginal) sur certaines lignes et certaines colonnes.
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 Private Sub CommandButton1_Click() Dim rectR As RECT, posP As POSITION, BoolRetour As Boolean posP = fPosCel(ActiveCell, BoolRetour) With UserForm2 .StartUpPosition = 0 .Show 0 .Top = fAjuste(CSng(posP.Top)) .Left = fAjuste(CSng(posP.Left)) End With If BoolRetour = True Then rectR = fMarges(UserForm2) With UserForm2 .Top = fAjuste(CSng(.Top + rectR.Top)) .Left = fAjuste(CSng(.Left + rectR.Left)) End With End If End Sub
Image UserForm en C3 :
Pièce jointe 295551
image Userform en E5 :
Pièce jointe 295554
Bonjour Franck
Les valeurs des membres du rectangle doivent à mon sens être également ajustés
Pour être plus général : ajuster par la fonction tout ce qui résulte de calculs.
Jacques,
J'ai ajusté tout ce qui pouvait l'être.
Même résultat.
J'ai même testé ma fonction fPosCel avec fAjuste comme ceci :
Je n'ai eu que le mot fin...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 Sub Test_Ajuste() Dim Cel As Range, b As Boolean, d As Single, c As Single, e As Single For Each Cel In ActiveWindow.VisibleRange d = fPosCel(Cel, b).Top 'même chose avec Left e = d c = fAjuste(d) If c <> e Then MsgBox Cel.Address Next Cel MsgBox "fin" End Sub
Donc, la fonction qui retourne le positionnement des cellules est correcte, et ne nécessite pas d'ajustement.
En ce qui concerne les "marges" dues à aero, je l'ai désactivé donc elles sont = 0.
Pas besoin d'ajuster non plus.
bonjour a tous
j'arrive un peu tard
jacques pour que les choses soit clair dans mon esprit: ton pixparpoint tel qu'il est écrit dans ta fonction n'est pas bon on est d'accord? ou c'est un arrondi volontaire?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Private Function ajuste(v As Single) As Single pixparpoint = 1.333333 '---->> si 96 dpi -->> adapter à votre dpi v = v * pixparpoint ' --->> nb décimal de pixels ajuste = WorksheetFunction.Round(v, 0) ' --->> nb entier de pixels le plus proche ajuste = WorksheetFunction.Round(ajuste / pixparpoint, 2) ' ---> nb "ajusté" de points End Function
Bonjour oudouner
comme je te l'ai déjà dis cela dépend de ton mode affichage double écran
tu a 2 possibilité
soit extension du bureau sur écran 2
soit écran supplémentaire
de cela dépend tes calcul
si tu ne sais pas le mode il suffit simplement de regarder en bas si tu a la barre des taches sur les deux écrans c'est que tu est en mode extension
au quel cas il va falloir que tu ajoute la dimension écran 2 dans tes calculs
si tu est en mode double écran il va te falloir peut être simplement ajouter dans tes valeur pixels la dimension complète de l'écran 1
je crois me souvenir mais je n'en suis pas sur que dans getsystemmetrics tu a les constantes (dimensions)des deux écrans réunis
a toi de vérifier
ce n'est pas cela, qui est mis en cause.Donc, la fonction qui retourne le positionnement des cellules est correcte, et ne nécessite pas d'ajustement
Ce qui peut influer est par contre le calcul des coordonnées après calcul de tes deux correctifs. Il implique que les coordonnées résultantes correspondent à un nombre entier de pixels.
Je n'ai pas tout ton code sous les yeux, mais il me semble (de mémoire) me rappeler que la fonction fMarges calcule entre autres des différences de coordonnées entre le usf et le rectangle étendu aero. A ce niveau, déjà (à vérifier) il parait prudent d'appliquer l'ajustement aux valeurs des coordonnées car un décalage pourrait résulter du fait de nombres non entiers de pixels.
Toutes ces coordonnées (tant du usf que du rectangle étendu) me paraissent devoir être "ajustées".
Cette fonction te retourne ensuite les deux "corrections" nécessaires, que tu vas appliquer à l'userform lui-même. A ce niveau également tu modifies les coordonnées en points du usf. "ajuste" ces coordonnées par la fonction avant leur application.
Important (dit plus haut) lorsque tu calcules en utilisant des valeurs à ajuster, fais tes calculs en utilisant l'ajustement de chaque valeur.
le résultat, par exemple, de ceci :
ajuste(toto - titi) est différent de ajuste(toto) - ajuste(titi)
A Patrick
rondi volontaire?jacques pour que les choses soit clair dans mon esprit: ton pixparpoint tel qu'il est écrit dans ta fonction n'est pas bon on est d'accord? ou c'est un ar
Il n'est là sous cette forme que pour ne pas "encombrer" trop, c'est tout. Et son arrondi ne provoque pas d'écart significatif dans notre "affaire"
Il est à remplacer en vrai (dans le code final) par :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 Dim pixparpoint As Double, objWSH As Object Set objWSH = CreateObject("WScript.Shell") pixparpoint = objWSH.RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / Application.InchesToPoints(1) MsgBox pixparpoint
Pour ne rien laisser au hasard et être très précis :
Le dernier test que tu as fait (celui du placement d'un userform par rapport à un autre) et qui n'a rien à voir avec les cellules d'une feuille ni avec le zoom appliqué, a montré la fiabilité sans faille des fonctions de la librairie dwmapi.dll.
Ces fonctions permettent de placer exactement un userform à des coordonnées spécifiées.
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é !![]()
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