Discussion :

[unparia]

Oui, Franck
Et reste également (et je crois savoir déjà comment le faire) à traiter différemment selon que :
- aero présent et activé
- aero non présent du tout (activé ou non)
Pour que la chose soit totalement universelle.

Là, je dois maintenant partir pêcher.
A plus.

[Invité]

Merci Franck
Tu auras finalement fait cuire toi le reste de la sauce.
C'est en effet bien le résultat que je pensais que nous obtiendrions. (Sans la "banane" étrange et inutile -1, au passage )

Merci à toi également Oudouner

J'aurai aussi la possibilité de tester ton code sur un autre poste (sous Windows 10) en fin de journée, si tu es intéressé par les résultats obtenus, je les posterai aussi en fin de journée.

[patricktoulon]

bonjour a tous

faite moi plaisir essayez votre "marque" a tous les zooms
et entre parenthèse pour W 7 2007
tout le code qu'il y a dans marque
je peut le remplacer par
usf.width-usf.insidewidth et pour diminuer l'ecart que que l'on vois perdurer et augmenter dans les gros zoom alors *zooom

j'ai strictement le même résultat
alors la sauce oui la votre mais désolé de le redire les cote obtenue par cet api on obtiens absolument les meme avec getwindowrect,getsytemmetric, etc

et elles sont pas justes a tout les zooms

pour la simple et bonne raison et la je le redis encore une fois l'agrandissement de ce qui est affiché a l'écran pour l'horizontal ne respecte pas le zoom a 100%
on a toujours le même problème depuis le début

même si je vous l'accorde ,comme je l'ai déjà dis ,visuellement le résultat est acceptable mais absolument pas exact!!!

[pijaku]

bonjour a tous

faite moi plaisir essayez votre "marque" a tous les zooms

Bonjour Patrick,

Fait de 50 à 400 sans souci.


@Jacques, pour aero activé ou non, il suffit de tester toto dans la fonction.
Si toto.Left (ou .Top) = 0 alors aero est désactivé.
Ce qui donne la fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Public Function Marges(Capt$, L#, T#, ppx#) As RECT
    Dim toto As RECT, titi As Long, HwndUsf As Long ' ----->> le rectangle étendu que l'on veut extraire (aero, donc)
    HwndUsf = FindWindow(vbNullString, Capt)
    titi = DwmGetWindowAttribute(HwndUsf, DWMWA_EXTENDED_FRAME_BOUNDS, toto, LenB(toto))
    If toto.Left = 0 Then
        Marges.Left = toto.Left
        Marges.Top = toto.Top
    Else
        Marges.Left = L - (toto.Left / ppx)
        Marges.Top = T - (toto.Top / ppx)
    End If
End Function

[patricktoulon]

salut franck

je te site

Code :

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

1
2
3
4
5
*** Pourquoi presque :
 Le type RECT ainsi présenté renvoie des Long.
 Or l'approximation peut avoir une valeur décimale.
 Chez moi, l'approximation du Top est de 3,75, ici la fonction me retourne 4 à juste titre.
 Mais bon, visuellement l'usf est pile poil dans la cellule !!!

sauf que moi avec 2007 sur W7 j'obtiens avec l'api et ppx 3.5 pour le left et 3.5 pour le top

alors qu'il me faut 4.8 pour être correcte

[pijaku]

En utilisant usf.width-usf.insidewidth chez moi (W7 + 2010), cela me décale l'userform d'un demi-point vers la droite et, du coup, il n'est plus placé rigoureusement sur le bord gauche de la cellule.

EDIT : et je te dis pas la plantade lorsque aéro est désactivé...
usf.width-usf.insidewidth décale franchement...

Pièce jointe 294567

[Nicolas JACQUIN]

Bonjour à tous,
pour w10 excel 2016 c'est nickel

merci les artistes

[patricktoulon]

franck ton code tel quel j'ai juste changer le nom du userform "userform1"

2 zoom différents

[pijaku]

Je ne sais pas quoi te répondre Patrick.
Si ce n'est qu'il s'agit peut être d'un souci avec 2007.
Il faudrait que quelqu'un d'autre teste pour en avoir le cœur net...

Regarde chez moi :

zoom 300 :

Pièce jointe 294601

zoom 400 :

Pièce jointe 294606

EDIT : la fonction utilisée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function fMarges(Usf_Caption As String, Usf_Left As Double, Usf_Top As Double) As RECT
Dim LngResult As Long, LngHwnd As Long, DblPpx As Double
 
    With CreateObject("WScript.Shell")
        DblPpx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    End With
    LngHwnd = FindWindow(vbNullString, Usf_Caption)
    LngResult = DwmGetWindowAttribute(LngHwnd, DWMWA_EXTENDED_FRAME_BOUNDS, fMarges, LenB(fMarges))
    If fMarges.Left <> 0 Then
        fMarges.Left = Usf_Left - (fMarges.Left / DblPpx)
        fMarges.Top = Usf_Top - (fMarges.Top / DblPpx)
    End If
End Function

[pijaku]

Pour le souci avec les volets figés, existe t'il une autre méthode en remplacement de ceci :

Code :

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

1
2
ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top)
ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left)

J'ai pas envie de relire les 45 pages... Désolé

[unparia]

Je ne serais pas outre-mesure étonné de ce qu'un certain "brouillon/vedette" ait une fois de plus mis la propriété startupposition de l'userform en autre chose que 0 (manual) ...

[pijaku]

Je ne serais pas outre-mesure étonné de ce qu'un certain "brouillon/vedette" ait une fois de plus mis la propriété startupposition de l'userform en autre chose que 0 (manual) ...

Normalement non car je l'ai inclus dans le code du bouton.

franck ton code tel quel j'ai juste changer le nom du userform "userform1"

[patricktoulon]

Pour le souci avec les volets figés, existe t'il une autre méthode en remplacement de ceci :

Code :

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

1
2
ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top)
ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left)

J'ai pas envie de relire les 45 pages... Désolé

non il n'existe pas d'autre méthode visiblement qui donne un résultat correcte
et surtout pas s'en passer car le theme utilisé (aero ou autre) modifie aussi l'affichage d'Excel
je l'ai déjà démontré avec ppx2
c'est pour ca que je hurle a quelqu'un qui ne veut rien entendre que ce vous trouvez avec votre api je le trouve avec pointstoscreenpixels chez moi

j'avoue ne pas savoir encore comment rendre cela universel dans le sens de l'ajustement (en positif ou négatif )

un exemple chez moi donc qui fonctionne
et même la encore c'est pas complètement exact car j'utilise le coefficient zoom qui ne correspond pas réellement aux zoom appliqué en terme de ce que l'on voit a l'ecran en largeur et hauteur
cela aussi je l'ai démontré

analyse bien ppx et ppx2

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
Private Sub CommandButton1_Click()
Dim L, T#, R As RECT, ppx#, usf
Set usf = UserForm1
 
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
 
    With ActiveWindow
    Z = (ActiveWindow.Zoom / 100)
    ppx2 = ((.ActivePane.PointsToScreenPixelsX([A1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / [A1].Width) / Z ' coefficient p to pix réellement appliqué
     l1 = (((.ActivePane.PointsToScreenPixelsX(usf.Width) - .ActivePane.PointsToScreenPixelsX(0))) / ppx2) ' width userform en pixel par le coeeficient réellement appliqué
    l2 = (((.ActivePane.PointsToScreenPixelsX(usf.Width) - .ActivePane.PointsToScreenPixelsX(0))) / ppx) ' width userform en pixel par le coéfficient pretendu
 
     t1 = (((.ActivePane.PointsToScreenPixelsX(usf.Height) - .ActivePane.PointsToScreenPixelsX(0))) / ppx2) 'pareil pour le height --> coefficient réellement appliqué
    t2 = (((.ActivePane.PointsToScreenPixelsX(usf.Height) - .ActivePane.PointsToScreenPixelsX(0))) / ppx) 'pareil coefficient pretendu
     'resultat dans message
     MsgBox (t1 - t2) * ppx / (ActiveWindow.Zoom + 1 / 100)
    MsgBox (l1 - l2) * ppx / (ActiveWindow.Zoom + 1 / 100)
    End With
 
    With UserForm1
       .StartUpPosition = 0
        .Show 0
        .Top = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx) + (t1 - t2) * ppx / (ActiveWindow.Zoom / 100)
        .Left = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) + (l1 - l2) * ppx / (ActiveWindow.Zoom / 100) ' - 5
 
  End With
 
End Sub

[patricktoulon]

Je ne serais pas outre-mesure étonné de ce qu'un certain "brouillon/vedette" ait une fois de plus mis la propriété startupposition de l'userform en autre chose que 0 (manual) ...

comme je te l'ai dis je le touche jamais ca je show 0 tout le temps

[pijaku]

Patrick

1- ne confonds pas ShowModal et StatUpPosition

2- testé ton code ==> retour à la case départ :

Pièce jointe 294647

t1 est toujours égal à t2, l1 est toujours égal à l2...

De plus je ne comprends pas ceci :

Code :

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

ActiveWindow.Zoom + 1 / 100

[patricktoulon]

t1 est toujours égal à t2, l1 est toujours égal à l2...

dans ce cas la tu n'a pas besoins d'ajustement ca correspond bien au switch 6.01-14 qui est = a 0

donc toi c'est

Code :

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

.left=activewindow.activepane.pointstoscreenpixelx(activecell.left)/ppx

tout court

en fait il faut ajouter le même test que tu fait avec le résultat de l'api sur le 0

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
Private Sub CommandButton1_Click()
Dim L As Double, T As Double, R As RECT, ppx#, usf
Set usf = UserForm1
 
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
 
    With ActiveWindow
    Z = (ActiveWindow.Zoom / 100)
    ppx2 = ((.ActivePane.PointsToScreenPixelsX([A1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / [A1].Width) / Z ' coefficient p to pix réellement appliqué
     l1 = (((.ActivePane.PointsToScreenPixelsX(usf.Width) - .ActivePane.PointsToScreenPixelsX(0))) / ppx2) ' width userform en pixel par le coeeficient réellement appliqué
    l2 = (((.ActivePane.PointsToScreenPixelsX(usf.Width) - .ActivePane.PointsToScreenPixelsX(0))) / ppx) ' width userform en pixel par le coéfficient pretendu
     L = IIf(l1 - l2 <> 0, (l1 - l2) * ppx / (ActiveWindow.Zoom / 100), 0)
     t1 = (((.ActivePane.PointsToScreenPixelsX(usf.Height) - .ActivePane.PointsToScreenPixelsX(0))) / ppx2) 'pareil pour le height --> coefficient réellement appliqué
    t2 = (((.ActivePane.PointsToScreenPixelsX(usf.Height) - .ActivePane.PointsToScreenPixelsX(0))) / ppx) 'pareil coefficient pretendu
          T = IIf(t1 - t2 <> 0, (t1 - t2) * ppx / (ActiveWindow.Zoom / 100), 0)
 
     'resultat dans message
     MsgBox (t1 - t2) * ppx / (ActiveWindow.Zoom / 100)
    MsgBox (l1 - l2) * ppx / (ActiveWindow.Zoom / 100)
    End With
 
    With UserForm1
       .StartUpPosition = 0
        .Show 0
        .Top = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx) + L
        .Left = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) + T
 
  End With
 
End Sub

[pijaku]

Non Patrick.
La correction a appliquer dans mon cas est de 4.
Résultats obtenus en tâtonnant et confirmés par l'api.

Donc, ton code fonctionne avec aero désactivé, mais pas s'il est activé.

Par contre, j'en reviens au remplacement de ceci :

Code :

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

1
2
ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top)
ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left)

Si c'est impossible, il faut alors renoncer à placer un Userform si les volets sont figés.

[pijaku]

On n'est jamais mieux servi que par soi-même.

Une feuille de calcul (volets figés ou non), un CommandButton1, un UserForm2 et un module standard (Module1) :

Code de Module1 :

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
Option Explicit
 
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
 
Public Type RECT
       Left As Long
       Top As Long
       Right As Long
       Bottom As Long
End Type
 
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
 
Dim Col As Long, Lig As Long
 
Public Function fPosCel(Rng As Range) As RECT
Dim P As Long, ptpx As Double
 
    ptpx = ppx(72)
    For P = 1 To ActiveWindow.Panes.Count
        With ActiveWindow.Panes(P)
            If Not Intersect(Rng, .VisibleRange) Is Nothing Then
                fPosCel.Left = .PointsToScreenPixelsX(Rng.Left) / ptpx
                fPosCel.Top = .PointsToScreenPixelsY(Rng.Top) / ptpx
                fPosCel.Right = Rng.Width
                fPosCel.Bottom = Rng.Height
                Exit For
            End If
        End With
    Next
End Function
 
Public Function fMarges(Usf_Caption As String, Usf_Left As Double, Usf_Top As Double) As RECT
Dim LngResult As Long, LngHwnd As Long, DblPpx As Double, BoolFreeze As Boolean
 
    DblPpx = ppx(72)
    If ActiveWindow.FreezePanes = True Then BoolFreeze = True: Call Libere(False)
    LngHwnd = FindWindow(vbNullString, Usf_Caption)
    LngResult = DwmGetWindowAttribute(LngHwnd, DWMWA_EXTENDED_FRAME_BOUNDS, fMarges, LenB(fMarges))
    If fMarges.Left <> 0 Then
        fMarges.Left = Usf_Left - (fMarges.Left / DblPpx)
        fMarges.Top = Usf_Top - (fMarges.Top / DblPpx)
    End If
    If BoolFreeze Then Call Refige(True)
End Function
 
Private Function ppx(Nb As Long) As Double
    With CreateObject("WScript.Shell")
        ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / Nb
    End With
End Function
 
Private Sub Libere(Comment As Boolean)
    With ActiveWindow
        Col = .SplitColumn
        Lig = .SplitRow
        .FreezePanes = Comment
    End With
End Sub
 
Private Sub Refige(Comment As Boolean)
    With ActiveWindow
        .SplitColumn = Col
        .SplitRow = Lig
        .FreezePanes = Comment
    End With
End Sub

Code dans la feuille (bouton) :

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 L#, T#, R As RECT, ppx#
 
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With UserForm2
        .StartUpPosition = 0
        .Show 0
        .Top = fPosCel(ActiveCell, ppx).Top
        .Left = fPosCel(ActiveCell, ppx).Left
    End With
    R = fMarges(UserForm2.Caption, UserForm2.Left, UserForm2.Top)
    L = R.Left
    T = R.Top
    With UserForm2
        .Top = UserForm2.Top + T
        .Left = UserForm2.Left + L
    End With
End Sub

Si la fonction fMarges vous mets un message d'erreur constante requise, remplacer DWMWA_EXTENDED_FRAME_BOUNDS par 9.

Merci, par avance, de vos retours.

[Invité]

Avec le code de pijaku :

[patricktoulon]

oui pikaju c'est pareil de toute Facon 9 est une constante thickborderframe with style( bordure ayant subi un style)
j'aimerait bien savoir si vous avez le même résultat que moi
a savoir 9,9,3,1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub test()
'SM_CXSIZEFRAME 32  : Return the width of a thick window frame.
MsgBox GetSystemMetrics(32)
'SM_CYSIZEFRAME 33   Return the height of a thick window frame.
MsgBox GetSystemMetrics(33)
'SM_CYDLGFRAME 8  : Return the height of a window frame having a dialog frame style.
MsgBox GetSystemMetrics(8)
'SM_CYBORDER 6  : Return the height of a window border. Win 95/98: Return the height of a single window border
MsgBox GetSystemMetrics(6)
 
End Sub

si c'est le cas les constantes sont écrit en dur dans la dell et donc fausses des le départ