XL 2016 VBA - Exact Visible Range

Dudu2 · 27 Novembre 2024

Bonjour,

VBA nous donne un Window.VisibleRange qui inclut les dernières colonne et ligne pas forcément complètement visibles.
C'est souvent handicapant quand on veut avoir un Window.ExactVisibleRange qui exclut les parties non visibles des dernières colonne et ligne.

J'ai dû faire un code sans trop d'API pour tenter de définir cet ExactVisibleRange mais hélas, j'ai aussi dû utiliser des constantes qui semblent valides chez moi. Mais le sont-elles chez vous ?

VB:

Const VerticalScrollBarBordersPixels As Long = 2 * 2.5    'Borders around the Vertical Scroll Bar
Const HorizontalScrollBarBordersPixels As Long = 2 * 4    'Borders around the Horizontal Scroll Bar
Const StatusBarHeightPixels = 26

Merci par avance de tester ce code pour vérifier qu'en toutes configurations de fenêtre (maximisée et réduite), la Shape Rectangle s'affiche bien aux limites basses de la partie visible.
Si ce n'est pas le cas, un petit screenshot et des infos sur la version Window et Office (versions et bits)

Fichier: voir plus loin

Dudu2 · 1 Décembre 2024

Edit: fichier mis à jour le 03/12/2024 à 16h03

Dudu2 · 1 Décembre 2024

Oui, t'as raison, j'ai le même comportement.
Donc mes corrections sur la Window (que je fais en Line.Weigth = 0 pour détecter l'apparition de la bordure lorsque je fais +/- 1 pixel) ne sont pas homogènes, dommage !
La détection au trait rouge est moins évidente selon où Excel place l'épaisseur du trait.

Qu'à cela ne tienne, j'ai corrigé les corrections !

VB:

With Window
    EVRRS = ExactVisibleRangeRECTToScreen(Window)
    EVRRW.Left = EVRRS.Left - .PointsToScreenPixelsX(0) + CXBORDER
    EVRRW.Right = EVRRS.Right - .PointsToScreenPixelsX(0) + IIf(.DisplayVerticalScrollBar, CXBORDER, 0)
    EVRRW.Top = EVRRS.Top - .PointsToScreenPixelsY(0) + CYBORDER
    EVRRW.Bottom = EVRRS.Bottom - .PointsToScreenPixelsY(0) + IIf(Application.DisplayStatusBar, CYBORDER, 0)
End With

Note qu'avec ta méthode j'avais aussi des corrections sur le RECT Window.

J'ajoute que le RECT en absolu sur le Screen est tout à fait correct, il n'a pas de corrections et est basé sur les Usable.

Dudu2 · 1 Décembre 2024

c'est le principe du getpixel en fait sauf que la on a un object retourné
si c'est pas nothing on est donc dedans
donc il ne peut pas y avoir d'erreur puisque je descend pixel par pixel et va a droite pixel par pixel

Oui, je sais bien mais cette méthode RangeFromPoint et la méthode Usable donnent un résultat différent de 1 pixel en H et V en maximisé (en réduit je sais pas, je vais essayer en forçant les tailles de fenêtre).

Alors j'ai analysé la différence précise du positionnement du UserForm (qui utilise le RECT Screen sans corrections) selon les 2 méthodes:

Avec la méthode Usable, les traits droit et bas du UserForm sont parfaitement alignés sur les limites du visible.

Avec la méthode RangeFromPoint, il y a un micro-décalage qui correspond à ce pixel manquant.

Alors certes, il ne s'agit que de 1 pixel, mais si on veut que le RECT soit parfaitement exact, un pixel, ça compte.

Dudu2 · 1 Décembre 2024

J'ai testé en mode réduit et il y a aussi un résultat différent de 1 pixel en H et V. Voilà les 2 fichiers.

A noter qu'en échelle 125% chez moi, en réduit, selon la taille de la fenêtre, il peut y avoir 2 pixels d'écart car le Usable rend 1 pixel de trop, mais c'est en 125%, je sais pas s'il faut en tenir compte.

A noter également que dans ta méthode RangeFromPoint, il suffit que tu ne retires pas ce dernier pixel à la fin des 2 boucles et tu seras pile poil sur le Usable et même meilleur chez moi en échelle 125%.
Edit: En fait non, il faut bien le retirer pour que le RangeFromPoint fonctionne jusqu'au bout. Mais c'est ensuite qu'il faut ajouter 1 dans le RECT.Right et le RECT.Bottom.

Edit: Finalement j'ai mais les 2 versions dont le RangeFromPoint avec ce pixel en plus et elles donnent les mêmes résultats, sauf dans mon cas d'échelle à 125% où le Usable rend parfois 1 pixel de trop.

patricktoulon · 1 Décembre 2024

re
j'ai modifié ma fonction trottitrota je vais jusqu'au nothing et pas -1
je test avec le curseur
regarde bien la position du curseur en bas à droite

donc ma fonction donne le bon rectangle
maintenant pour corriger l'affichage du userform je n'utilise pas dwm
j'utilise clientToscreen .x et .y par rapport au getwindowsrect du userform .left

j'ai un assez bon résultat
mode maximisé

apres pour le problème qui se passe en 125% ben je crois que c'est simple en fait
il faudrait que je te fasse un fichier à tester pour confirmer ma théorie
en fait ma théorie est simple
je crois que en dpi 96 ou 120 getsystemmetrics donne les mêmes valeurs
en 96 donc par exemple
SM_CXBORDER qui donne 1 pixel *0,75 donne 0.75 point
en 120 ça donnerais 1 pixel*0.6 soit 0.6 point
alors certes celui qui a perdu sa grand mère n'ira pas la chercher là mais si on met bout à bout ces petits écart de pixel font la différence

fait le test en 96 et 120 msgbox getsystemmetrics(46) par exemple et dis moi si c'est pareil pour les deux
si c'est pas le cas pour que tes calculs soient universels
il te faudra faire la multiplication par 1.25 afin que les résultats soient cohérents

Dudu2 · 1 Décembre 2024

maintenant pour corriger l'affichage du userform je n'utilise pas dwm

Si tu ne le fais pas tu ne peux pas vérifier visuellement dans le brouillard des marges droite et basse.

J'ai modifié les fichiers du post précédent (#123) en ajoutant le pixel manquant et maintenant les 2 méthodes donnent le même résultat (sauf le pixel en trop parfois selon les dimensions de la fenêtre en 125% 120dpi du Usable en Width et en Height, problème qui n'existe pas avec le RangeTopoint au pixel ajouté.

Dudu2 · 1 Décembre 2024

Quant aux corrections sur le RECT relatif à la Window, j'ai longtemps hésité car je ne sais pas vraiment, quelque soit la Line.Weight (0 ou 1), où se situe exactement la Shape.

Alors je suis revenu sur la ligne rouge de Line.Weight = 1 apparente en bordure et finalement j'aime bien la cohérence et la simplicité des corrections effectuées qui s'appliquent évidemment aux 2 méthodes et qui semblent appropriées.

VB:

With Window.Panes(1)
    EVRRS = ExactVisibleRangeRECTToScreen(Window)
    EVRRW.Left = EVRRS.Left - .PointsToScreenPixelsX(0) + CXBORDER
    EVRRW.Right = EVRRS.Right - .PointsToScreenPixelsX(0)
    EVRRW.Top = EVRRS.Top - .PointsToScreenPixelsY(0) + CYBORDER
    EVRRW.Bottom = EVRRS.Bottom - .PointsToScreenPixelsY(0)
End With

J'ai à nouveau modifié les fichiers du post précédent (#123) pour y inclure cette modif.

patricktoulon · 1 Décembre 2024

je viens de tester sur 365 sur un portable
et ma fonction GetrealRectanglevisibleRange donne un résultat exacte
parti de la la rectification se fait avec les éléments de l'object que l'on veux positionner ou redimensionner
pour un userform on a des tas de chose dwm getsystemmetrics etc...
encore faut il les utiliser et surtout les bons ;c'est a dire que le return de ces outils doit être bon que ce soit chez toi ou chez moi en 100% ou 125%
a l'heure actuelle on est tres proche mais on est pas égale

je souhaiterais vraiment que tu teste msgbox getsystemmetrics(46) en 100% et en 125%
afin que je puisse confirmer et finaliser les correcteurs afin qu'il soit universels

patricktoulon · 1 Décembre 2024

je souhaiterais vraiment que tu teste msgbox getsystemmetrics(46) en 100% et en 125%
afin que je puisse confirmer et finaliser les correcteurs afin qu'il soit universels

Dudu2 · 1 Décembre 2024

Code:

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
#Else
    Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetDpiForWindow Lib "user32" (ByVal hwnd As Long) As Long
#End If

Public Function GetDpi() As Long
    GetDpi = GetDpiForWindow(ActiveWindow.hwnd)
End Function

Sub a()
    Const SM_CXEDGE = 45
    Const SM_CYEDGE = 46
    
    MsgBox "DPI = " & GetDpi & vbCrLf & _
           "SM_CXEDGE = " & GetSystemMetrics(SM_CXEDGE) & vbCrLf & _
           "SM_CYEDGE = " & GetSystemMetrics(SM_CYEDGE)
End Sub

Dudu2 · 1 Décembre 2024

En 96 DPI (100%)

Constant	Index	Pixels	Points
SM_CXSCREEN	0	1920	1440
SM_CYSCREEN	1	1080	810
SM_CXVSCROLL	2	17	12,75
SM_CYHSCROLL	3	17	12,75
SM_CYCAPTION	4	23	17,25
SM_CXBORDER	5	1	0,75
SM_CYBORDER	6	1	0,75
SM_CXDLGFRAME	7	3	2,25
SM_CYDLGFRAME	8	3	2,25
SM_CYVTHUMB	9	17	12,75
SM_CXHTHUMB	10	17	12,75
SM_CXICON	11	32	24
SM_CYICON	12	32	24
SM_CXCURSOR	13	32	24
SM_CYCURSOR	14	32	24
SM_CYMENU	15	20	15
SM_CXFULLSCREEN	16	1920	1440
SM_CYFULLSCREEN	17	1017	762,75
SM_CYKANJIWINDOW	18	0	0
SM_MOUSEPRESENT	19	1	0,75
SM_CYVSCROLL	20	17	12,75
SM_CXHSCROLL	21	17	12,75
SM_DEBUG	22	0	0
SM_SWAPBUTTON	23	0	0
SM_RESERVED1	24	0	0
SM_RESERVED2	25	0	0
SM_RESERVED3	26	0	0
SM_RESERVED4	27	0	0
SM_CXMIN	28	136	102
SM_CYMIN	29	39	29,25
SM_CXSIZE	30	36	27
SM_CYSIZE	31	22	16,5
SM_CXFRAME	32	4	3
SM_CYFRAME	33	4	3
SM_CXMINTRACK	34	136	102
SM_CYMINTRACK	35	39	29,25
SM_CXDOUBLECLK	36	4	3
SM_CYDOUBLECLK	37	4	3
SM_CXICONSPACING	38	93	69,75
SM_CYICONSPACING	39	75	56,25
SM_MENUDROPALIGNMENT	40	0	0
SM_PENWINDOWS	41	0	0
SM_DBCSENABLED	42	0	0
SM_CMOUSEBUTTONS	43	16	12
SM_CMETRICS	44	0	0
SM_CXEDGE	45	2	1,5
SM_CYEDGE	46	2	1,5
SM_CXMINSPACING	47	199	149,25
SM_CYMINSPACING	48	34	25,5
SM_CXSMICON	49	16	12
SM_CYSMICON	50	16	12
SM_CYSMCAPTION	51	23	17,25
SM_CXSMSIZE	52	22	16,5
SM_CYSMSIZE	53	22	16,5
SM_CXMENUSIZE	54	19	14,25
SM_CYMENUSIZE	55	19	14,25
SM_ARRANGE	56	8	6
SM_CXMINIMIZED	57	199	149,25
SM_CYMINIMIZED	58	34	25,5
SM_CXMAXTRACK	59	1940	1455
SM_CYMAXTRACK	60	1100	825
SM_CXMAXIMIZED	61	1936	1452
SM_CYMAXIMIZED	62	1056	792
SM_NETWORK	63	3	2,25
	64	0	0
	65	0	0
	66	0	0
SM_CLEANBOOT	67	0	0
SM_CXDRAG	68	4	3
SM_CYDRAG	69	4	3
SM_SHOWSOUNDS	70	0	0
SM_CXMENUCHECK	71	15	11,25
SM_CYMENUCHECK	72	15	11,25
SM_SLOWMACHINE	73	0	0
SM_MIDEASTENABLED	74	0	0
SM_MOUSEWHEELPRESENT	75	1	0,75
SM_XVIRTUALSCREEN	76	0	0
SM_YVIRTUALSCREEN	77	0	0
SM_CXVIRTUALSCREEN	78	1920	1440
SM_CYVIRTUALSCREEN	79	1080	810
SM_CMONITORS	80	1	0,75
SM_SAMEDISPLAYFORMAT	81	1	0,75
SM_IMMENABLED	82	1	0,75
SM_CXFOCUSBORDER	83	1	0,75
SM_CYFOCUSBORDER	84	1	0,75
	85	4	3
SM_TABLETPC	86	0	0
SM_MEDIACENTER	87	0	0
SM_STARTER	88	0	0
SM_SERVERR2	89	0	0
	90	0	0
SM_MOUSEHORIZONTALWHEELPRESENT	91	0	0
SM_CXPADDEDBORDER	92	4	3
	93	964	723
SM_DIGITIZER	94	0	0
SM_MAXIMUMTOUCHES	95	0	0

Dudu2 · 1 Décembre 2024

En 120 DPI (125%)

Constant	Index	Pixels	Points
SM_CXSCREEN	0	1920	1152
SM_CYSCREEN	1	1080	648
SM_CXVSCROLL	2	21	12,6
SM_CYHSCROLL	3	21	12,6
SM_CYCAPTION	4	29	17,4
SM_CXBORDER	5	1	0,6
SM_CYBORDER	6	1	0,6
SM_CXDLGFRAME	7	3	1,8
SM_CYDLGFRAME	8	3	1,8
SM_CYVTHUMB	9	21	12,6
SM_CXHTHUMB	10	21	12,6
SM_CXICON	11	40	24
SM_CYICON	12	40	24
SM_CXCURSOR	13	32	19,2
SM_CYCURSOR	14	32	19,2
SM_CYMENU	15	25	15
SM_CXFULLSCREEN	16	1920	1152
SM_CYFULLSCREEN	17	1001	600,6
SM_CYKANJIWINDOW	18	0	0
SM_MOUSEPRESENT	19	1	0,6
SM_CYVSCROLL	20	21	12,6
SM_CXHSCROLL	21	21	12,6
SM_DEBUG	22	0	0
SM_SWAPBUTTON	23	0	0
SM_RESERVED1	24	0	0
SM_RESERVED2	25	0	0
SM_RESERVED3	26	0	0
SM_RESERVED4	27	0	0
SM_CXMIN	28	166	99,6
SM_CYMIN	29	47	28,2
SM_CXSIZE	30	46	27,6
SM_CYSIZE	31	28	16,8
SM_CXFRAME	32	4	2,4
SM_CYFRAME	33	4	2,4
SM_CXMINTRACK	34	166	99,6
SM_CYMINTRACK	35	47	28,2
SM_CXDOUBLECLK	36	4	2,4
SM_CYDOUBLECLK	37	4	2,4
SM_CXICONSPACING	38	116	69,6
SM_CYICONSPACING	39	94	56,4
SM_MENUDROPALIGNMENT	40	0	0
SM_PENWINDOWS	41	0	0
SM_DBCSENABLED	42	0	0
SM_CMOUSEBUTTONS	43	16	9,6
SM_CMETRICS	44	0	0
SM_CXEDGE	45	2	1,2
SM_CYEDGE	46	2	1,2
SM_CXMINSPACING	47	199	119,4
SM_CYMINSPACING	48	34	20,4
SM_CXSMICON	49	20	12
SM_CYSMICON	50	20	12
SM_CYSMCAPTION	51	29	17,4
SM_CXSMSIZE	52	28	16,8
SM_CYSMSIZE	53	28	16,8
SM_CXMENUSIZE	54	24	14,4
SM_CYMENUSIZE	55	24	14,4
SM_ARRANGE	56	8	4,8
SM_CXMINIMIZED	57	199	119,4
SM_CYMINIMIZED	58	34	20,4
SM_CXMAXTRACK	59	1942	1165,2
SM_CYMAXTRACK	60	1102	661,2
SM_CXMAXIMIZED	61	1938	1162,8
SM_CYMAXIMIZED	62	1048	628,8
SM_NETWORK	63	3	1,8
	64	0	0
	65	0	0
	66	0	0
SM_CLEANBOOT	67	0	0
SM_CXDRAG	68	4	2,4
SM_CYDRAG	69	4	2,4
SM_SHOWSOUNDS	70	0	0
SM_CXMENUCHECK	71	19	11,4
SM_CYMENUCHECK	72	19	11,4
SM_SLOWMACHINE	73	0	0
SM_MIDEASTENABLED	74	0	0
SM_MOUSEWHEELPRESENT	75	1	0,6
SM_XVIRTUALSCREEN	76	0	0
SM_YVIRTUALSCREEN	77	0	0
SM_CXVIRTUALSCREEN	78	1920	1152
SM_CYVIRTUALSCREEN	79	1080	648
SM_CMONITORS	80	1	0,6
SM_SAMEDISPLAYFORMAT	81	1	0,6
SM_IMMENABLED	82	1	0,6
SM_CXFOCUSBORDER	83	1	0,6
SM_CYFOCUSBORDER	84	1	0,6
	85	4	2,4
SM_TABLETPC	86	0	0
SM_MEDIACENTER	87	0	0
SM_STARTER	88	0	0
SM_SERVERR2	89	0	0
	90	0	0
SM_MOUSEHORIZONTALWHEELPRESENT	91	0	0
SM_CXPADDEDBORDER	92	5	3
	93	964	578,4
SM_DIGITIZER	94	0	0
SM_MAXIMUMTOUCHES	95	0	0

Dudu2 · 1 Décembre 2024

Là-dessus je vais faire du vélo. Il fait un temps splendide !

Le fichier pour les SystemMetrics.

patricktoulon · 1 Décembre 2024

bon ben voila j'ai la confirmation de ce que je redoutais
voilà pourquoi il y a toujours une différence
si tu corrige avec SM_CXBORDER par exemple qui donne 1 pixel
quand tu est en 125 il vaut 0.6 point et en 100 il vaut 0.75 point
ça confirme donc ce que je pensais

que l'on utilise par les bons même si ça coïncide (a peu près ) à 1 ou deux pixel près

donc en 125% ça devrait être
(getsystemmetrics(SM_CXBORDER)*ptopx)*(getDpiForwindow(app.hwnd)/96)

en 100%getDpiForwindow(app.hwnd)/96 donne 1
et en 125% il donne 1.25

tu te rendrais compte alors que ça (enlève ou ajoute )(trop ou pas assez) selon le sens de la correction
et que donc seules les constantes ad hoc sont nécessaires

patricktoulon · 1 Décembre 2024

tiens si je reprends tes tableaux
il n'y a pas quelque chose qui te gène là
GetsystemMetrics Table

Constant	Index	Pixels	Points
SM_CXSCREEN	0	1920	1152	125%
SM_CYSCREEN	1	1080	648	125%
SM_CXVSCROLL	2	21	12,6	125%
SM_CYHSCROLL	3	21	12,6	125%

SM_CXVSCROLL	2	17	12,75	100%
SM_CYHSCROLL	3	17	12,75	100%

pour toi c'est normal que les scrollbar soient plus petites en 125%
moi je n'ai même pas besoins de pied a coulisse pour voir ce qui est a l’écran
voila il est ou ton pixel de plus ou moins et selon ca peut être pire

Dudu2 · 1 Décembre 2024

J'ai fait tous mes réglages à 100% 96 dpi. Et les 2 fichiers du Post #123 sont parfaits chez moi et doivent l'être chez toi au minimum pour le UserForm (qui utilise le RECT relatif au Screen). Et comme la correction est minime je pense aussi en Shape Rectangle (qui utilise le RECT relatif à la Window).

En 125% 120 dpi, il y a des petits effets de bord d'1 pixel parfois en trop en Usable UserForm et en moins en RangeFromPoint Shape Rectangle. Mais je ne vais pas chercher à corriger ces variations de 1 pixel qui ne relèvent pas du calcul dans le code VBA. Ça n'a d'ailleurs pas d'importance vu que presque tout le monde travaille à 96 dpi 100% et qu'il s'agit d'un écart d'1 seul pixel pour ceux qui comme moi finissent de vieillir et passent en 125% pour y voir clair.

XL 2016 VBA - Exact Visible Range

Dudu2

XLDnaute Barbatruc

Dudu2

Dudu2

XLDnaute Barbatruc

Pièces jointes

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc