Discussion :

[unparia]

Juste pour ton info, Patrick : des tests déjà faits sans aero depuis chez moi ont fonctionné exactement de la même manière chez Franck.
Je n'ai nul besoin de posséder aero pour raisonner (je te l'ai déjà dit il y a plusieurs jours )

pour ma part le chalenge était de ne pas se servir d'api et autre Object externe donc en ce qui me concerne le challenge est rempli chez moi pour W7 et W10

Ben ... dépose alors une contribution.
Non ?

[patricktoulon]

non je veux que ce soit parfait (visuellement parlant )

pour moi j'ai un code qui sans le modifier fonctionne dans tout les theme sur Windows 7 et sans utiliser de chiffre a additionner ou soustraire en dur tout est pris dans l'app et regedit

je l'ai dis plus haut y a pas que les apis regedit te donne et permet d'aller chercher "si ceci alors cela sinon inversement "etc..etc...

je vais des aujourd'hui travailler en collaboration avec Nicolas qui avec ces retours me donnera la possibilité d'adapter aussi a W10 TOUT THEMES

je mettrais en dernier la condition nul sur Xp

tu le vois tout themes en gros et gras et ben cherche avec regedit ; et ben non tu peux pas !! XP et comme Xp n'a pas besoins de redressage tes possibilités de trouver sans apis

s'arrêtent là, a moins d'attendre les retours de franck

tu veux une démo animée avec w7 thème(basic, classic window , aero, et autres )

comme franck a W7 je suis sur qu'il a compris

c'est d'une simplicité en plus

Nicolas je te contacte très vite

[Nicolas JACQUIN]

ça marche

[unparia]

tes possibilités de trouver sans apis

s'arrêtent là, a moins d'attendre les retours de franck

Tu crois ? Si les retours des tests chez Franck confirment : ni fonctions de l'Api, ni même nécessité de déterminer le DPI (ni même en utilisant WScript.Shell - qui demeure un "tiers" externe à VBA -, ni même en lisant la base de registre. Je n'en tiens même pas compte, de ce DPI - pas plus que du zoom, d'ailleurs) . Et sans "correctif/cataplasme" en dur. Et avec un code ultra court.

et comme Xp n'a pas besoins de redressage

Erreur ! XP également

[unparia]

J'ai une "bonne ?" nouvelle pour toi, Patrick
Les résultats sur la machine de Franck, avec ou sans aero, sont exactement les mêmes que sur la mienne.
Il ne reste qu'un cas particulier assez rare (et qui vient d'être décelé) à régler.

PS : Il est plus que vraisemblable (et pour cause) que ton code en étude se heurtera (pour la même raison) au même cas particulier.

[patricktoulon]

Bonjour jacques
la tu suscite ma curiosité !!!!

1. pas d'api
2. pas de registre
3. pas de tier
4. pas de zoom

tu fait comment tu lance ton userform comme une fléchette en plissant un peu la paupière

et des cas rare( exceptionnel, bizarre) il y en a plus d'un

ma fois propose ton code pour que je puisse comprendre et y travailler dessus de mon coté

je soupçonne que tu utilise un array ou une shape deux méthodes que j'ai déjà exploré

mais attention ne te réfère pas que a franck sur W7 c'est très facile de palier au décalage contrairement a W10 tu va avoir des surprises

je veux bien voir l'ébauche de ce raisonnement

[patricktoulon]

en attendant voici une version alltheme W7
relativement simple comme 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
Sub all_themesW_7()
    Dim PpXO As Double, Theme_aero As Boolean, BdW#, LFT, TP
    With CreateObject("WScript.Shell")
        PpXO = .regread("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
        themes = .regread("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\CurrentTheme")
        Theme_aero = Not themes Like "*classic*" And Not themes Like "*basic*"
    End With
    With ActiveWindow
        BdW = IIf(Theme_aero, UserForm1.Width - UserForm1.InsideWidth, 0)
        LFT = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / PpXO) + BdW
        TP = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / PpXO) + BdW
    End With
    With UserForm1
        .StartUpPosition = 0
        .Show 0
        .Left = LFT    '(ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / PpXO) + BdW
        .Top = TP    '(ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / PpXO) + BdW
    End With
End Sub

et celui la prends même en compte les thèmes contraste élevés (2 cles regedit)

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
Sub all_themesW_7_bis()
    Dim PpXO As Double, Theme_aero As Boolean, BdW#, LFT, TP
    With CreateObject("WScript.Shell")
        PpXO = .regread("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
        Theme_actif = .regread("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager\ThemeActive")
       themes = .regread("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\CurrentTheme")
      Theme_aero = Theme_actif = 1 And Not themes Like "*basic*"
    End With
    With ActiveWindow
        BdW = IIf(Theme_aero, UserForm1.Width - UserForm1.InsideWidth, 0)
        LFT = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / PpXO) + BdW
        TP = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / PpXO) + BdW
    End With
    With UserForm1
        .StartUpPosition = 0
        .Show 0
        .Left = LFT    '(ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / PpXO) + BdW
        .Top = TP    '(ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / PpXO) + BdW
    End With
End Sub

le principe
tout les thèmes hors classic window et contraste élevés = thème actif=1 sinon 0
tout les autre c'est thème active 0 par contre le thème "basic" = 1 aussi mais ne subit pas le décalage
conclusion bdw prend le thickframe selon cette simple condition
Theme_aero = Theme_actif = 1 And Not themes Like "*basic*"

[unparia]

je soupçonne que tu utilise un array ou une shape deux méthodes que j'ai déjà exploré

mais attention ne te réfère pas que a franck sur W7 c'est très facile de palier au décalage contrairement a W10 tu va avoir des surprises

- Un array ou une shape ? Pour quoi faire ?
- W7 ou W10 ou ce que tu voudras ...
- ma fois propose ton code pour que je puisse comprendre et y travailler dessus de mon coté
...
[QUOTE]je veux bien voir l'ébauche de ce raisonnement
Pour quoi faire ? Pour courir le risque de dispersions diverses à nouveau ? -->> O que Non. Tu le connaîtras lorsque définitivement arrêté.

PS : je constate que tu ne passes enfin plus par la valeur 0 de PointsToScreenPixelsX/Y. C'est déjà mieux.

[Nicolas JACQUIN]

Bonjour à tous
Je ne repars pas sur 50 pages promis, mais ton code Patrick ne colle du tout chez moi en top ou left, je ne sais pas pour vous autres
je sais que ma solution est pas miracle pour vous, mais je n'ai aucun soucis avec, avec n'importe quel dizaine ou unité de 50 à 400

Code :

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

1
2
3
4
5
6
7
8
9
Sub testwidth2() 
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
  With UserForm1
    bord = ((.InsideWidth - .Width) / 2) + 1 ' = -5  ma correction à appliquer Windows 10 64bits et excel 2016 32bits
    .Show 0
    .Left = ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx + bord
    .Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
  End With
End Sub

Bonne continuation.

[patricktoulon]

je te promet que si tu me la donne je travaillerais dessus sans la dévoiler et te ferais part de mes constatations en MP

@Nicolas je te prépare des tests

[patricktoulon]

nicolas la bonne blague c'est prévu que pour 2007

[patricktoulon]

dis moi juste ce que donne ca sur tes deux pc W10

Code :

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

bord = (.InsideWidth - .Width)

[patricktoulon]

ce qui me perturbe c'est le fait que le width de l'userform soit plus petit que le insidewidth chez toi Nicolas
-12 veut dire que ton insidewidth est plus grand que le width de 12 point
oupss!! j'avais pas vu que tu avais inverser dans la formule
bord = ((.InsideWidth - .Width) / 2) + 1

on est donc a moins 7
tu veux bien essayer de remplacer ton +bord par +-8.39

[Nicolas JACQUIN]

.width = 240
.insidewidth = 228

228 - 240 = -12
-12 / 2 = -6
-6 + 1 = -5

[patricktoulon]

ok donc ca correspond bien a getsystemetrics(6 et 8) qui te donne respectivement 4 et 1 pour la bordure simple et la Gw_STYLE

donc (240-(4+1))-228=7
CA tente a confirmer ce que je disais plus haut il y a un effet "BLIND" sur la captions et cadre des fenêtres

[Patrice740]

Bonjour Patrick, Bonjour Nicolas,

Je ne voudrais pas mettre de l'huile sur l'usf,
mais voila ce que donnent vos 2 derniers codes,
chez moi, avec Windows 10 et Excel 2016 32 bits :

[Nicolas JACQUIN]

Bonjour Patrice, oui on a les mêmes versions , ça me réconforte, je suis pas fou, enfin je pense

[patricktoulon]

je le répète car visiblement vous avez pas compris tout les deux les deux dernières versions UNIQUEMENT w7!!!!!
donc vos tests n'ont pas lieu d'être
je dois parler chinois moi des fois

bon nicolas tu confirme le -7 pour le fixe et -3.xxx pour le portable

ok on se croisent a chaque fois
tu confirme Nicolas que ta sub fonctionne sans rien changer sur tes deux PCS

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub testwidth2() 
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
  With UserForm1
    bord = ((.InsideWidth - .Width) / 2) + 1 ' = -5  ma correction à appliquer Windows 10 64bits et excel 2016 32bits
    .Show 0
    .Left = ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx + bord
    .Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
  End With
End Sub

[Nicolas JACQUIN]

je dois parler chinois moi des fois

moi aussi cher ami

bord = ((.InsideWidth - .Width) / 2) + 1 ' = -5

.width = 240
.insidewidth = 228

228 - 240 = -12
-12 / 2 = -6
-6 + 1 = -5 sur win10 2016 32bits



-3.600006 sur w10 2013 64bits

[Nicolas JACQUIN]

je le répète car visiblement vous avez pas compris tout les deux les deux dernières versions UNIQUEMENT w7!!!!!
donc vos tests n'ont pas lieu d'être
je dois parler chinois moi des fois

bon nicolas tu confirme le -7 pour le fixe et -3.xxx pour le portable

ok on se croisent a chaque fois
tu confirme Nicolas que ta sub fonctionne sans rien changer sur tes deux PCS

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub testwidth2() 
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
  With UserForm1
    bord = ((.InsideWidth - .Width) / 2) + 1 ' = -5  ma correction à appliquer Windows 10 64bits et excel 2016 32bits
    .Show 0
    .Left = ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / ppx + bord
    .Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / ppx
  End With
End Sub

J'avais pas vu ta modif
excel 2016 32 ça marche sans aucun probleme, n'importe quel zoom, dizaine et unité

excel 2013 64 décalage de 1 pixel en top ou left + ou - , n'importe quel zoom, dizaine et unité
mais en mettant "round" c'est mieux ça dépend des cellules