Discussion :

[unparia]

Dans la foulée :
Il n'est pas impossible que la discussion suivante :
http://www.vbforums.com/showthread.p...g-Aero-Borders
Contienne des indications très importantes, tout au moins très intéressantes.
Je n'ai pas la possibilité (n'ayant pas aero) de tenter de les exploiter ...

[patricktoulon]

ca y est il debarque
allo la lune !! on l'avais compris et je vais mémé plus loin selon le thème utilisé sur W7 ca change et même sur W10 on a vu ca avec nicolas et j'ai trouvé le moyen de le déterminer (Nicolas tu le garde pour toi pour le moment )

en attendant Nicolas la formule devrait être simplement ceci tu constatera que je n'utilise même pas le zoom dans la formule

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub testwidth2()
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
With ActiveWindow
x = .ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx
Y = .ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
End With
With UserForm1
plus = Round(Int(.Width - .InsideWidth) / 2)
.Show 0
.Left = x - plus
.Top = Y
End With
End Sub

[unparia]

"on" l'avais compris

mais sans jamais en tenir compte ? Comme de tout le reste (également su mais délibérément ignoré) ?
Je sais maintenant que la solution rustine n'est pas viable

[Nicolas JACQUIN]

oui ça marche, je l'avais fait remarqué dans ce code

Code :

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

1
2
3
4
5
6
7
8
Sub Aligne_forme_simple()
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager\LastLoadedDPI") / 72: End With
With UserForm1
.Show 0
.Top = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx)
.Left = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) ' - 5
End With
End Sub

edit

et "plus" c'est pas "/2" mais par 1.333333333333333

mon optique c'était largeur total - largeur intérieur diviser par deux coté

[patricktoulon]

ou la tu deraille toi aussi
tu veux dire que la formule simple ne nécessite plus d'ajustement chez toi avec tes deux pcs ????????

edit

et "plus" c'est pas "/2" mais par 1.333333333333333


mon optique c'était largeur total - largeur intérieur diviser par deux coté

c'est un calcul logique mais basé sur de fausse donnée le width et Insidewidth est inscrit en dur dans les propriété du userform dans le VBE mais il est différent selon le thème

[Nicolas JACQUIN]

non j'ai pas dis ça, c'était un essai que j'avais fais sur le fixe avec le -5 c'était ok
https://www.developpez.net/forums/d1...a/#post9439141

[patricktoulon]

relis le post 865

[Nicolas JACQUIN]

ben je savais pas

[unparia]

c'est un calcul logique mais basé sur de fausse donnée le width et Insidewidth est inscrit en dur dans les propriété du userform dans le VBE mais il est différent selon le thème

Veux-tu bien, Patrick, corriger les termes utilisés dans cette phrase ? Juste pour :
- être très précis
- montrer que tu sais très exactement de quoi tu parles
- éviter que les autres lecteurs de cette discussion confondent certaines choses différentes entre elles

C'est pour le moins souhaitable ...

[unparia]

Ouais ...
Bon ...
Voilà à quoi on arrive lorsque, sans posséder aero (hein, Patrick ...) :
- on cherche à comprendre ce qu'est le redessin (un rectangle qui se superpose bel et bien au Userform) créé par aero
- on cherche à voir ce que sont la librairie et la fonction qui figurent dans le lien que j'ai mis dans mon message 861, à savoir :
http://www.vbforums.com/showthread.p...g-Aero-Borders
- on découvre qu'elle utilise une énumération (non exposée dans le lien) , exposée ici :
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
qu'en lisant attentivement ce dernier lien on voit bien que l'on peut extraire le rectangle étendu (le redessin aero)
La seule chose que j'ignore encore est s'il est en plus nécessaire de préciser la valeur de certaines des constantes de l'énumération utilisée ou si ces valeurs sont implicites.

J'en arrive donc à proposer un code qui devrait être très proche de celui-ci :

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 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 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
 
Public Sub testons_donc ()
    dim toto As RECT ' ----->> le rectangle étendu que l'on veut extraire (aero, donc) 
    titi =  dwmGetWindowAttribute(le_hwnd_de_userform, DWMWA_EXTENDED_FRAME_BOUNDS, toto, LenB(toto))
    msgbox toto.left & vbcrlf & toto.top '--->> puisque toto est un rectangle typé comme la structure RECT.
End Sub

Je laisse ceux qui ont une version avec aero corriger/compléter au besoin ce premier jus (qui devrait ne pas être très loin de la bonne sauce).
Commencer déjà par remplacer le_hwnd_de_userform par le hwnd du userform (utilisation de FindWindows)
Signé : un "sans aero" (coucou Patrick)
Bonne nuit.

[patricktoulon]

ceci: chez moi place le userform nikel sauf que j'ai enlevé l'ajustement donc trop court

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 testwidth2()
    With ActiveWindow
        Z = .Zoom / 100
        With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
        'ppx = (ActiveWindow.ActivePane.PointsToScreenPixelsX([A1:B1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / [A1:B1].Width / Z
        x = (.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) + 1) / ppx
        x2 = (.ActivePane.PointsToScreenPixelsX(Range(Cells(1, 1), ActiveCell).Width - ActiveCell.Width)) / ppx
        Y = .ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
    End With
    With UserForm1
        plus = Round(.Width - .InsideWidth)
        Debug.Print plus
        .Show 0
        .Left = x2 + 4    ' plus
        .Top = Y + 4    'plus
    End With
End Sub

ton test que lance tout de suite apres

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
 
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 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
 
Public Sub testons_donc()
    Dim toto As RECT ' ----->> le rectangle étendu que l'on veut extraire (aero, donc)
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
      ' UserForm1.Show 0
    hwndusf = FindWindow(vbNullString, UserForm1.Caption)
    titi = DwmGetWindowAttribute(hwndusf, DWMWA_EXTENDED_FRAME_BOUNDS, toto, LenB(toto))
    x = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) + 1)
 
 
 
    MsgBox toto.Left & vbCrLf & toto.Top & vbCrLf & x  '--->> puisque toto est un rectangle typé comme la structure RECT.
End Sub

résultât


sauf que chez moi 6 c'est 2 de trop

edit oupss!! n

on c'est presque bon la différence de 7 est en pixel donc / par ppx on obtiens exactement !!!!!!ce que j'obtiens avec usf.width-usf.insidewidth

c'est a dire 3.509xxxxxx
sauf que ce chiffre est trop court selon les zoom

conclusion cet api a le me soucis que gerwindowrect elle donne la théorie mais pas la pratique

cela dit le resultat est raisonablement corect pour un simple visuel

mais comme j'ai la meme chose sans tu vois ce que je veut dire

[unparia]

Le test que tu fais de mon premier jus de code me parait donc très bon !
Et cette remarque :

conclusion cet api a le me soucis que gerwindowrect elle donne la théorie mais pas la pratique

Montre que tu n'as pas du tout compris comment utiliser les résultats affichés
Vraiment ! Ce bout de code te permet tout simplement de calculer très exactement la rustine/ordonnée et la rustine/abscisse (2 soustractions toutes bêtes) !
Tu te réveilles, oui ?
Tu veux que je te donne la becquetée avec une cuillère en quel métal, Patrick ?

EDIT : et nous avons maintenant la preuve de ce que je ne cessais de répéter en vain : nous avons bel et bien :
- une fenêtre userform (fenêtre windows à part entière) qui ne bouge ni n'est redimensionnée en aucun cas
- un rectangle plus grand qui la recouvre, sans être pour autant une fenêtre windows à part entière et donc sans hwnd.

Allez va -->> je préfère aller dormir.
Je te la servirai, ta becquetée, si tu n'es toujours pas capable de manger tout seul.

[patricktoulon]

Vraiment ! Ce bout de code te permet tout simplement de calculer très exactement la rustine/ordonnée et la rustine/abscisse (2 soustractions toutes bêtes) !
Tu te réveilles, oui ?
Tu veux que je te donne la becquetée avec une cuillère en quel métal, Patrick ?

vraiment tu commence a me les chauffer toi a me prendre pour un con et a deformer tout ce que je dis

je t'ais dis OUI!!! mais chez moi en point l'ajustement est de 4.8 en plus pour que se soit nikel
7 pixels / ppx n'a jamais fit 4.8 points

ok tromblon
et je te le répète cart t'a l'air un peu boucjhé

AVEC USF.WITH-USF.INSIDEWIDTH J OBTIENS EXACTEMENT LA MEME CHOSE
C EST CLAIR COMME CA
VA DORMIR TRONC DE L AIR

[unparia]

Le "tronc de l'air", Patrick, n'aime pas les peaux de bananes non plus (et en plus)
Et je n'aime pas celle que tu as mise (traitreusement ?) là :

Code :

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

x = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) + 1)

Tu la vois ? (elle est en rouge).
C'est une plaisanterie de plus ?
Et essaye de rester maître de toi-même, hein ...

[patricktoulon]

puré même ca il faut que je te montre hein
t a rien pigé a Windows 7 tu ne fait que supputer

Code :

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

1
2
3
4
5
6
7
8
Sub testwidth2()
    With ActiveWindow
        Z = .Zoom / 100
        With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
        Debug.Print "PointsToScreenPixelsX  " & .ActivePane.PointsToScreenPixelsX(ActiveCell.Width) - .ActivePane.PointsToScreenPixelsX(0)
        Debug.Print "width  fois ppx " & ActiveCell.Width * ppx
    End With
End Sub

sincèrement jacques arrêtes tes connerie w7 et certainement les supérieurs tant pige pas une miette
commence d'abords par t'en servir après tu pourra affirmer quoi que se soit

[unparia]

puré même ca il faut que je te montre hein

Ben, pour l'instant, ce que tu m'as "montré" en 43 pages, n'est pas "brillant" brillant" et plutôt "brouillon brouillon".
Et jusqu'à présent : il ne me semble pas que l' "universalité" recherchée ait été atteinte.

sincèrement jacques arrêtes tes connerie w7 et certainement les supérieurs tant pige pas une miette
commence d'abords par t'en servir après tu pourra affirmer quoi que se soit

Je ne vois pas pourquoi W7 travaillerait différemment tant en ce qui concerne la détermination des coordonnées d'un point qu'en ce qui concerne celles de l'angle supérieur gauche d'une fenêtre.
Si tel était le cas, tout un tas d'applications graphiques (quel que pût être le langage de développement utilisé) seraient soumises à des aléas, d'une version à l'autre de Windows ! Enorme, donc, ta "remarque" !

Bon ...
Je vais donc tout écrire de A à Z et en utilisant le code que j'ai montré (celui passant par une fonction de l'Api)
On verra bien, hein, en jugeant non sur des "convictions"****** , mais sur pièces.

****** Et à propos de "convictions" maintenant bien mises à mal à propos de ce que je disais concernant ce qu'était le "redessin" aero : explique pourquoi toi, qui "connaît" W7 et ultérieurs, en savait moins que moi à ce propos.
Alors excuse-moi, hein ... mais tes affirmations ne sont pas pour moi de l'argent comptant, loin de là.

Et dis-moi : si tes convictions sont fondées à ce propos : il va falloir que tu traites également cette différence entre une version et l'autre pour assurer "l'universalité" ...

[pijaku]

Bonjour,

Belle avancée Jacques !


Ce code fonctionne presque*** chez moi (W7, excel 2010).
Une feuille, un CommandButton et un Userform (UserForm2).
Dans un module standard :

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
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
 
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))
    Marges.Left = L - (toto.Left / ppx)
    Marges.Top = T - (toto.Top / ppx)
End Function

Le code du 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 = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx)
        .Left = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx) ' - 5
    End With
    R = Marges(UserForm2.Caption, UserForm2.Left, UserForm2.Top, ppx)
    L = R.Left
    T = R.Top
    With UserForm2
        .Top = UserForm2.Top + T
        .Left = UserForm2.Left + L
    End With
End Sub

UserForm2 en B3 :

Pièce jointe 294551

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

[Invité]

Bonjour,

De la même manière que pijaku, le code de Jacques marche très bien de mon côté ! (W7 Professional, Excel 2010 (32 bits))

[unparia]

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

[pijaku]

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

De rien Jacques.
Reste néanmoins le cas ou les volets sont figés.
Excel envoie alors mon UserForm dans les choux!

Il faut donc ajouter un test complémentaire :

Code :

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

1
2
3
4
5
6
Si les volets sont figés Then
     stocke comment sont figés ces volets
     défige les volets
     calcule
     place et refige
Fin Si