Discussion :

[mjpmjp]

bonjour,
j'avais posté une "anim" sur le décalage de ligne ICI Page 33 #655

W10 e10
@+JP

[unparia]

A Franck

Oui...
Mais depuis le début de cette discussion, on ne peux émettre que des suppositions...

Ce ne sera pas une supposition, mais bel et bien une preuve.
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...

[pijaku]

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!!

[unparia]

A Franck :

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...

Je n'ai pas zappé cette partie de ton message.
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 ...

[patricktoulon]

@ Patrick :
C'est bien, mais comment calcule tu ton "plus"??????

le calcul tu l'a dans le code je récupère seulement le width -insidewidth +2
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

[unparia]

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"

[unparia]

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 :

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

Exemple d'appel :

Code :

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

1
2
3
Dim toto As Single
 toto = ajuste(400)
MsgBox toto

Faites des essais à comparer avec les résultats en agissant comme en mon message 962 -->> toujours bon.

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 ) :

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

Voilà ... je vous laisse maintenant utiliser tout cela dans le code complet du sujet principal

[pijaku]

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 :

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

Si l'on dé-commente les 3 lignes, on obtient :

Pièce jointe 295518

[unparia]

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 :

Code :

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

.Left = ajuste(UserForm1.Left) + ajuste(UserForm1.Width)

Car l'arrondi d'un total n'est pas égal à la somme des arrondis

[pijaku]

Bon...
Pas sur d'avoir bien fait...
Voici le code :

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

Et les résultats :

Accolement horizontal :
Pièce jointe 295519
Accolement vertical :
Pièce jointe 295521
Ce que nous voulions :
Pièce jointe 295524

[unparia]

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.

[Invité]

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.

[pijaku]

Avec le code :

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

en DPI = 120, zoom 260% (juste pour mieux distinguer), j'obtiens un léger décalage (marginal) sur certaines lignes et certaines colonnes.

Image UserForm en C3 :
Pièce jointe 295551

image Userform en E5 :
Pièce jointe 295554

[unparia]

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.

[pijaku]

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 :

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

Je n'ai eu que le mot fin...
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.

[patricktoulon]

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

[patricktoulon]

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.

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

[unparia]

Donc, la fonction qui retourne le positionnement des cellules est correcte, et ne nécessite pas d'ajustement

ce n'est pas cela, qui est mis en cause.
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)

[unparia]

A Patrick

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

rondi volontaire?

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

[unparia]

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é !