Positionner curseur sur une cellule sélectée Windows Excel VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

Re, voici sans API, moi ça marche , quand on monte dans les grand zoom il y à léger décalage, pas loin du but

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function PositionForm(FORM As Object, rng As Range)
Dim K As Double, Z As Double
 
Z = ActiveWindow.Zoom / 100
K = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Z
 
lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 6
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
PositionForm = Array(lleft, ttop)
 
End Function
 
Sub TestUserform()
    r = PositionForm(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

;)

28/05/2017, 11h10
unparia

Citation:

quand on monte dans les grand zoom il y à léger décalage

Tu auras ainsi toujours un décalage, dès que tu t'écarteras du zoom 100 %.
Le fait est tout simplement qu'il est bien évidemment plus visible en allant vars de grand zooms.
Il est clair que pour le même décalage relatif, le décalage absolu est plus ou moins visible (repérable visuellement) selon qu'on agrandit ou que l'on rapetisse.
Ce décalage est dû à la conjugaison de deux choses, auxquelles j'ai fait allusion plus haut :
- un pixel (plus petite partie graphique) ne peut être représenté avec exactitude en conservant ses proportions si on lui applique un coefficient
- il y a toujours perte de précision lorsque l'on fait successivement des opérations inverses (multiplication/division) sur un nombre

Corriger cela est possible, mais alors sans passer par des conversions d'unités graphiques et ainsi :
- en reprenant (en l'ayant "soupçonnée") la manière dont Microsoft a fait ses calculs pour garder à la fois précision et un rendu acceptable des traits. Il a tout simplement distingué dans ses calculs ce qu'il y a entre les bordures et les bordures elles-mêmes. Cela est particulièrement vrai, entre autres, pour le traitement de la barre de titres de la feuille active.

J'ai fais une légère correction, avec ou sans API, ça tombe précis chez moi. (Windows 10 et Excel 2016)
Avec API

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
 
Function PositionForm(Form As Object, rng As Range)
Dim K As Double, Z As Double
 
Z = ActiveWindow.Zoom / 100
K = GetDeviceCaps(GetDC(0), 88) / 72
K = GetDeviceCaps(GetDC(0), 90) / 72
 
lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 5
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
PositionForm = Array(lleft, ttop)
 
End Function
 
Sub TestUserform()
    r = PositionForm(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

Et sans API

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function PositionForm(FORM As Object, rng As Range)
Dim Z As Double, K As Double
 
Z = ActiveWindow.Zoom / 100
K = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Z
 
lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 6
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
PositionForm = Array(lleft, ttop)
 
End Function
 
Sub TestUserform()
    r = PositionForm(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

Je remerci toutefois Patrick et Unparia pour leurs aides (ou chamailleries je sais pas :zen: ), qui m'ont permis d'en arriver là. :ave:

28/05/2017, 15h17
unparia

ta proposition sans fonction de l'api de windows présente un décalage horizontal d'environ 2 pixels
Ce qui ne va pas, c'est la valeur -6 fixée en dur pour ce qui est du left et qui dépend de la résolution de l'écran (nombre de pixels par point horizontalement).
28/05/2017, 15h21
Nicolas JACQUIN

Citation:

Envoyé par unparia

ta proposition sans fonction de l'api de windows présente un décalage horizontal d'environ 2 pixels
Ce qui ne va pas, c'est la valeur -6 fixée en dur pour ce qui est du left et qui dépend de la résolution de l'écran (nombre de pixels par point horizontalement).

Oui j'ai essayé de trouver la solution pour corriger ça, mais je ne sais pas comment m'y prendre, mais chez moi ça colle

Que se passe-t-il sur ta machine en transformant ainsi ta fonction (calcul séparé de K et K1:

Code:

1
2
3
4
5
6
7
8
9
10
11
Function PositionForm(FORM As Object, rng As Range)
Dim Z As Double, K As Double
 
Z = ActiveWindow.Zoom / 100
K = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Z
K1 = ((ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsY(0)) / ActiveSheet.[A1].Width) / Z
lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K1 * Z) / K1
PositionForm = Array(lleft, ttop)
 
End Function

28/05/2017, 15h26
Nicolas JACQUIN

1 pièce(s) jointe(s)

ça revient au même que si je retire le -6
Pièce jointe 280118
j'avais déjà essayé ça
28/05/2017, 16h22
patricktoulon

1 pièce(s) jointe(s)

re

d'après la capture de nicolas vous être en train de trifouiller le paramètre que j'essaie de vous indicer depuis 3 jours

nicolas ton code tel quel me done ca :
Pièce jointe 280131
28/05/2017, 16h29
patricktoulon

re

je suppose que unparia doit avoir le même résultat avec W10 et 2007 tandis que Nicolas est bon avec W et 2010
et aussi que votre "-6" donne le résultat opposé l'un de l'autre hein!!!!?????

ca y est vous voyez la
28/05/2017, 16h29
Nicolas JACQUIN

Oui comme tu disais, cela dépend surement de la version, je peux pas mettre en mode petite fenêtre comme toi pour voir ce que ça donne, moi ça colle au poil fenêtre réduite ou pleine écran
28/05/2017, 16h41
patricktoulon

re

cadeau

Code:

cadre = IIf(Application.OperatingSystem Like "*/*" And application.version= 12, 0, 6)

et oui la différence n'est que entre w10 et 2007 pour les autres sauf retour négatifs que je n'ai pas encore eu pour 2016

autrement dit w7 2007 =cadre
w10 2007 =pas cadre
les autre rien
pour quoi me direz vous hein???

et bien il suffit de regarder nos captures et de voir qu'avec w7 l'userform a un cadre les autres non
par contre avec w10 le shell prend en charge l'affichage des fenêtres mémé les thunderframes(userform) et comme il n'a pas de cadre pour l'affichage des fenêtres dans W10 je vous le donne dans le mille

voila maintenant vous savez
oupss j'ai corriger le mot répété dans le code

Non patricktoulon, je n'ai pas la combinaison de version que tu dis.

A Nicolas JACQUIN :
Ton approche m'intéresse énormément, mais pas au prix d'une estimation en fonction de la/les version(s).
Nous allons, si tu veux bien, faire une petite expérience dont je souhaite connaître les résultats sur ta machine.
Elle a pour but de tenter de déterminer la véritable largeur totale de la bordure + titres de lignes
ATTENTION / à ce stade, je ne m'intéresse qu'à ce positionnement horizontal, sans encore traiter le scroll horizontal éventuellement utilisé.
Test à faire donc avec colonne A visible et première colonne
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Function PositionForm(FORM As Object, rng As Range) Dim G As Double, D As Double, K As Double, Z As Double Z = ActiveWindow.Zoom / 100 K = GetDeviceCaps(GetDC(0), 88) / 72 G = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K D = ActiveWindow.PointsToScreenPixelsX((rng.Left + rng.Width) * K * Z) / K K = GetDeviceCaps(GetDC(0), 90) / 72 'lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 0 '==> on va essayer autrement ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K corr = (ActiveWindow.Width - ActiveWindow.UsableWidth + 3) * Z lleft = Application.Left + ActiveWindow.Left + corr + (ActiveCell.Left * ActiveWindow.Zoom / 100) PositionForm = Array(lleft, ttop) End Function Private Sub CommandButton5_Click() Z = ActiveWindow.Zoom / 100 r = PositionForm(UserForm1, ActiveCell) With UserForm1 .Show 0: .Left = r(0): .Top = r(1) End With End Sub

28/05/2017, 17h03
Nicolas JACQUIN

1 pièce(s) jointe(s)

ça donne
Pièce jointe 280146
28/05/2017, 17h11
patricktoulon

re

unparia c'est quoi ta config ? vu les capture (dessin) que tu a posté il me semble bien reconnaitre 2007
28/05/2017, 17h30
unparia

Citation:

Envoyé par patricktoulon

unparia c'est quoi ta config ? vu les capture (dessin) que tu a posté il me semble bien reconnaitre 2007

Présentement : 2007 pour Office mais sur XP
Mais s'il faut passer par des si telle combinaison alors, sinon si ... etc ...
Je préfère alors ne pas profiter de calculs déjà faits et faire les miens, même si plus nombreux. ;)

Constat : si le fait de cadre ou pas cadre changeait quoi que ce fût, cela voudrait alors dire que les conversions internes du genre PointsToScreenPixelsX, PointsToScreenPixelsY de Microsoft Office comportent en elles-mêmes des erreurs ou omissions de calculs ;)
28/05/2017, 17h46
unparia

Je commence pour tout dire à me demander si ce ne sont pas les effets d'ombrage dont je vois qu'est doté le userform de Nicolas JACQUIN, qui, dans leur traitement, ne "déplacent" pas quelque peu le userform vers la droite !
28/05/2017, 18h25
Nicolas JACQUIN

Je ne sait plus quoi faire de mieux, comme je disais, avec ma config c'est au poil.
Après c'est sur que ça doit changer selon le système d'exploitation et de la version excel, plus tous les systèmes de personnalisation d'apparence selon les système.
Désolé pour les autres mais là je pense que s'il faut tenir compte de chaque paramètre ça va être compliqué, là je pense que c'est plus du cas par cas.

re
oui les ombrage y sont aussi pour quelque chose sur w7 aussi

nous savons que tout ce qui est au dessus de la lite d'entête colonne n'est pas touché par le zoom on est bien d'accords

et pourtant faite cette expérience résultat faux ou non on s'en fout les démentions ayant été calculées sur mon pc

c'est pas le but de l'expérience mais plutôt le comportement du zoom

faite le en zoom 100 puis augmentez le zoom et réessayez

la je suis perplexe :lol:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub test() Set cible = [D3] Set app = Application: Set actw = ActiveWindow: Set usf = UserForm1 Z = (actw.Zoom / 100) With actw.ActivePane: pppx = (.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3: End With Caption = usf.Height - usf.InsideHeight onglet = 19 ruban = (CommandBars("Ribbon").Height / pppx) - onglet - Caption formulbar = 19 headingbar = 18 * Z cadre = (app.Width - app.UsableWidth) - 1 With UserForm1 .Show 0 .Left = 150 .Top = app.Top + actw.Top + Caption + onglet + ruban + formulbar + Caption ' + headingbar .Height = 150 End With End Sub
alors si vous avez une explication digne de ce nom faite tourner

28/05/2017, 19h02
Nicolas JACQUIN

3 pièce(s) jointe(s)

j'ai fait à 100 110 120
Pièce jointe 280165
Pièce jointe 280166
Pièce jointe 280168

Pour moi la barre A B C .... des colonnes grandissent en hauteur avec le zoom et verticalement 1 2 3 .... pareils
28/05/2017, 19h45
patricktoulon

re

oui je sais ca mai tu a vu que le userform est prevu pour etre juste au niveau de la barre de formule en aucun cas le zoom devrait apporter une modification

Voir 40 message(s) de cette discussion en une page