XL 2016 VBA - Exact Visible Range

[Dudu2]

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 ?

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

 

[patricktoulon]

ça y est j'ai trouvé
la fonction pointstoscreenpixel X ou Y va te donner les points comme si il n'y avait pas de fraction ou figé ou les deux

j'ai testé en baladant le curseur
autrement dit là ou normalement le rangefrompoint me donne nothing et donc le do/loop s'arrete
il me donne encore un range quand il y a fractionnement et /ou figé

à retenir donc pour les pointstoscreenpixels

 

[Dudu2]

faut pas oublier que c'est moi qui t' ai donné cette astuce
donc celui qui sait le mieux c'est moi je pense

Là tu dis des bêtises mon @patricktoulon !
T'as trouvé cette astuce de RangeFromPoint, oui, c'est bien, bravo.
Mais une fois que tu l'as trouvée, moi ou quelqu'un d'autre peut l'exploiter à sa manière, ton code n'est pas à l'INPI.
Et moi alors, j'ai trouvé l'astuce des UsableWidth/Height moins les Headings.
Est-ce que je prétends que tu ne saurais pas l'exploiter mieux que moi ?

 

[patricktoulon]

quelle autre manière a tu de l'exploiter ? a part de faire une boucle avec incrémentation du pixel
rend à cesar ce qui est a cesar tu utilise exactement mon principe avec des nom de variable différente
après je m'en fou mais quand tu me dis "j’espère que tu comprends ça "
alors que c'est moi qui t'es donné l'astuce c'est un peu mutch
en plus me semble t il je l'explique dans une vidéo
si je sais pas, je vais t'écouter tester confirmer ou infirmer , mais n'essaie pas de m'apprendre ce moi je t'ai appris

ton usable-heading je ne sais pas je n'ai pas téléchargé le 2d fichier
perso il y a le getsystemmetrics avec quoi je le fait très bien peut être un problème de zoom excel à gérer

mais j'avoue que je suis plus intéressé par la version rangefrompoint en trottinant au moins celle là elle est plus sure
je vais peut être même pas regarder le 2d fichier tellement je suis convaincu que ma logique de trotinnette est de loin la plus sure

 

[patricktoulon]

pour info
avec la trottinette et les deux point zeo si je créée une shape sans correction et que je sauve cette shape en png avec ma fonction shapeTopngfile j'obtiens une image ou les dimensions sont exactement celles que me donne le rectangle

ça veux dire quoi finalement
et bien ça veux dire tout simplement que quand on arrange pour que ce soit bon à l’écran , la shape ne mesure plus réellement le rectangle
et comme le rectangle est exact (testé avec getcursorpos) je te laisse en tirer toi même les conclusions

 

[Dudu2]

Parfois je me demande si je dois te répondre...

quelle autre manière a tu de l'exploiter ? a part de faire une boucle avec incrémentation du pixel

[RAPPEL] -> J'ai dû adapter ton code pour:
1 - Partir de .PointsToScreenPixelsX/Y(.VisibleRange.Left/Top) et non pas .PointsToScreenPixelsX/Y(0) car ton code ne supporte pas le moindre Scroll.
2 - Faire la correction du pixel qui manque par rapport au UsableWidth/Height
3 - Partir de la dernière cellule de la dernière Pane pour éviter des boucles inutiles
4 - Séparer ce qui concerne le RECT du Screen pour positionner un UserForm par exemple, de ce qui concerne le RECT de la Window pour positionner un Objet dont le parent est la feuille, ce que tu n'as pas fait dans ton code.

rend à cesar ce qui est a cesar tu utilise exactement mon principe avec des nom de variable différente

Tu sais quoi ? Ton principe de César l'empereur qui domine le monde... tu peux te le garder avec ton hubris.
Pour cette fonctionnalité, je n'utiliserai désormais que ma solution. Et tu as de la chance que je mette les 2 options en solution du sujet et que je n'aie pas fait comme toi pour la ListBox.

 

[patricktoulon]

re

Partir de .PointsToScreenPixelsX/Y(.VisibleRange.Left/Top) et non pas .PointsToScreenPixelsX/Y(0) car ton

@Dudu2 t es pas sérieux tu te fou de moi la
et Vr dans mon code c'est quoi
et lastcell c'est c'est quoi

le problème quand tu copie mes code c'est que tu ne regarde pas tout après tu dis j'ai modifié
en fait tu réinvente ce que je fait mais tout y est déjà

pour le panes.count je te l'accorde ça ajoute une secu de plus de bien taper dans la droite

punaise par pitié regarde les variables locales tu comprendra

Function GetRectangleVisibleRange() As rectanglePlus
    'fonction created by patricktoulon
    Dim G#, T#, Vr As Range, LastCell As Range, D#, B#, Large#, Hauteur#, rect As rectanglePlus, PtoPx, z#
    PtoPx = PixelToPoint
    With ActiveWindow.Panes(1)
        z = .Parent.Zoom / 100
        G = .PointsToScreenPixelsX(0): T = .PointsToScreenPixelsY(0)
        Set Vr = .Parent.Panes(.Parent.Panes.Count).VisibleRange
        Set LastCell = Vr.Cells(Vr.Cells.Count).Offset(-1, -1)
        D = .PointsToScreenPixelsX(LastCell.Left): B = .PointsToScreenPixelsY(LastCell.Top)
        Do While Not .Parent.RangeFromPoint(D, B) Is Nothing: B = B + 1: DoEvents: Loop: B = B - 1
        Do While Not .Parent.RangeFromPoint(D, B) Is Nothing: D = D + 1: DoEvents: Loop: D = D - 1
        rect.LeftPixel = G: rect.TopPixel = T: rect.RightPixel = D: rect.BottomPixel = B
        rect.LeftPoint = G * PtoPx: rect.TopPoint = T * PtoPx: rect.RightPoint = D * PtoPx: rect.BottomPoint = B * PtoPx
        rect.WidthPixel = D - G: rect.WidthPoint = (D - G) * PtoPx
        rect.HeightPixel = B - T: rect.HeightPoint = (B - T) * PtoPx
        GetRectangleVisibleRange = rect
    End With
End Function

et pour info test ceci par pitié aussi j'en ai un peu marre de l'expliquer
fractionne ta feuille avant la colonne "P"et avant la ligne 18

Sub test()
With ActiveWindow.Panes(1)
MsgBox .PointsToScreenPixelsX([P18].Left)
MsgBox .Parent.Panes(4).PointsToScreenPixelsX([P18].Left)
MsgBox .Parent.Panes(.parent.panes.count).PointsToScreenPixelsX([P18].Left)
End With
End Sub

alors dit moi le panes4(ou panes.count) est il vraiment nécessaire ou pas pour le trottitrota???????????????

comme ça tu saura aussi combien mesure l’épaisseur du trait de fractionnement
ne me dit pas merci

 

[Dudu2]

Va voir la solution et constate que tout fonctionne parfaitement.

 

[patricktoulon]

ho mais je te crois que ça fonctionne mais ne dis pas que c'est ta méthode
c'est la mienne que tu a réécrite a ta sauce c'est tout
moi je m'attendais a ce que tu me mystifie avec les api


moi je reprends jamais tes codes
déjà par ce que faire des passerelles a gogo ne sert à rien
et tu en fait tellement qu'il me faut un décodeur de la naza pour décoder

et au fait j'ai d'ailleurs même essayé l'inverse qui est valable aussi
c'est a dire de partir du app.left+app.width*ppx et du app.top+app.height*ppx
et cette fois ci de revenir a reculons dans le trottinante
ben ça marche aussi

pour tout te dire on pourrait même prendre un point au centre et trottiner ça marcherait aussi et vu que l'on fait rien sur la feuille ni ou que ce soit pendant le trottinage
au test benchmark j'ai une différence de quelques µs
oui je dis bien nano secondes même pas un clignement de l’œil

 

[Dudu2]

mais ne dis pas que c'est ta méthode c'est la mienne que tu a réécrite a ta sauce c'est tout

Dans la solution il y a ta méthode que j'ai effectivement dû adapter car insuffisante pour satisfaire les objectifs.
Dans la solution il y a ma méthode tout à fait différente et parfaitement fonctionnelle.

 

[patricktoulon]

re
si tu veux tout savoir
voila de quoi est constituée la fenêtre excel
et l'indentation n'est pas là pour faire joli

window  descendantes de  Excel :
Handle: 198050, Classe: "EXCEL2 " [hauteur en point : 16,5]&     [largeur en point : -628,5]
    Handle: 198204, Classe: "MsoCommandBar  " [hauteur en point : 16,5]&     [largeur en point : -628,5]
        Handle: 329124, Classe: "MsoWorkPane    " [hauteur en point : 16,5]&     [largeur en point : -628,5]
            Handle: 198196, Classe: "NUIPane    " [hauteur en point : 16,5]&     [largeur en point : -628,5]
                Handle: 198092, Classe: "NetUIHWND  " [hauteur en point : 16,5]&     [largeur en point : -628,5]
Handle: 263614, Classe: "EXCEL2 " [hauteur en point : 110,25]&     [largeur en point : 3]
    Handle: 198080, Classe: "MsoCommandBar  " [hauteur en point : 110,25]&     [largeur en point : 3]
        Handle: 329222, Classe: "MsoWorkPane    " [hauteur en point : 110,25]&     [largeur en point : 3]
            Handle: 198172, Classe: "NUIPane    " [hauteur en point : 110,25]&     [largeur en point : 3]
                Handle: 198178, Classe: "NetUIHWND  " [hauteur en point : 110,25]&     [largeur en point : 3]
Handle: 198164, Classe: "EXCEL< " [hauteur en point : 34,5]&     [largeur en point : 181,5]
    Handle: 198170, Classe: "NUIScrollbar   " [hauteur en point : 0]&     [largeur en point : 198,75]
        Handle: 198100, Classe: "NetUIHWND  " [hauteur en point : 0]&     [largeur en point : 198,75]
Handle: 198098, Classe: "EXCEL; " [hauteur en point : 34,5]&     [largeur en point : -107,25]
    Handle: 198166, Classe: "ComboBox   " [hauteur en point : 18]&     [largeur en point : -111]
        Handle: 198106, Classe: "Edit   " [hauteur en point : 13,5]&     [largeur en point : -111]
Handle: 198180, Classe: "EXCELG " [hauteur en point : 0]&     [largeur en point : -628,5]
Handle: 198160, Classe: "EXCELG " [hauteur en point : 0]&     [largeur en point : 1058,25]
Handle: 198176, Classe: "EXCELG " [hauteur en point : 0]&     [largeur en point : -141,75]
Handle: 198174, Classe: "EXCELG " [hauteur en point : 0]&     [largeur en point : -141,75]
Handle: 590486, Classe: "EXCEL2 " [hauteur en point : 0]&     [largeur en point : 1058,25]
Handle: 393384, Classe: "EXCEL2 " [hauteur en point : 0]&     [largeur en point : -141,75]
Handle: 263212, Classe: "XLDESK " [hauteur en point : 486,75]&     [largeur en point : -141,75]
    Handle: 198102, Classe: "EXCEL7 " [hauteur en point : 486,75]&     [largeur en point : -141,75]
        Handle: 263580, Classe: "NUIScrollbar   " [hauteur en point : 468]&     [largeur en point : 1044]
            Handle: 198048, Classe: "NetUIHWND  " [hauteur en point : 468]&     [largeur en point : 1044]
        Handle: 198202, Classe: "NUIScrollbar   " [hauteur en point : 12]&     [largeur en point : 119,25]
            Handle: 590682, Classe: "NetUIHWND  " [hauteur en point : 12]&     [largeur en point : 119,25]
        Handle: 198046, Classe: "XLCTL  " [hauteur en point : 21]&     [largeur en point : 573]
        Handle: 590590, Classe: "XLCTL  " [hauteur en point : 3]&     [largeur en point : 1041,75]
        Handle: 198088, Classe: "XLCTL  " [hauteur en point : 20,25]&     [largeur en point : 102]
    Handle: 393822, Classe: "EXCEL6 " [hauteur en point : 0]&     [largeur en point : -141,75]
Handle: 198104, Classe: "MsoWorkPane    " [hauteur en point : 75]&     [largeur en point : 3]
Handle: 198090, Classe: "MsoWorkPane    " [hauteur en point : 75]&     [largeur en point : 3]

 

[patricktoulon]

@Dudu2
capture de ton fichier avec ma méthode trafiqué
scrollé en ligne 3 et colonne C

mon fichier avec la fonction originale
placé juste dessus au même endroit
scrollé en ligne 3 et colonne C

 

[Dudu2]

Bonjour,

Histoire de s'approcher de la vérité, j'ai refait des dizaines et des dizaines d'essais et ma conclusion est la suivante, suivant ma configuration (échelle 100%).

- La correction à appliquer paradoxalement est sur le RECT absolu du Screen car l'absence des Headings impacte le Left / Top / Right (étrangement pas le Bottom). J'ai vérifié la correction du RECT Screen avec le UserForm dont les bordures (marges retirées) sont à la limite des bordures de la fenêtre sans les recouvrir via des screenshot agrandits.

- Si l'absence des Headings a un impact sur le RECT Screen, l'absence des Scroll Bar, Formula Bar, Status Bar n'en a aucun.

- Il n'y a plus de correction sur le RECT relatif de la Window car la correction du RECT Screen a été préalablement appliquée avant son calcul qui consiste seulement à retirer les .PointsToScreenPixelsX/Y(0) du RECT Screen.

- J'ai inclus ton code qui avec les Headings est trop court d'1 pixel en H et V, c'est le pixel que j'ai dû ajouté en méthode RangeFromPoint+ et qui est inclus nativement dans la méthode Usable.

- Sans les Headings, ton code est bon en H car le H a perdu 1 pixel due à l'absence des Headings et ça correspond donc à ton pixel manquant. Mais il n'est pas bon en V, toujours trop court d'1 pixel car l'absence des Headings n'impacte étrangement pas le Bottom. Les Left et Top sont également incorrects dans ce cas car l'absence des Headings les impacte aussi de 1 pixel.

J'ai modifié le fichier de la solution en conséquence.

 

[patricktoulon]

re
oui la correction ne doit être appliquée(+1 ou -1) uniquement quand pas de heading
tout le reste des corrections ne doit être appliqué que sur les object shapes ou userform
tout simplement parce que
headings provoque une erreur de 1 pixel ou point (à l'oeil nu c'est la même chose)
splitrow et splitcolumn provoque un ajout de 4 points pour leur ligne respective de séparation
freezepanes réduite les split a 1 point
et bien évidement le displayscrollbar en maximisé ou il faut deduire le GLDframe(3pixel donc 2.25 points)

pour le userform j’enlève juste le gldframe
Attention pour les shapes quand on scroll on déplace l'affichage de la grille
pour contrôler l'exactitude il faut que les lignes et colonnes se suivent
alors comme tu l'a dit tu vois il faut déduire les point 0 ou prendre les point 0 du visiblerange
c'est exactement la même chose
MAIS SURTOUT!!!! ne pas confondre adapter avec les ceci et cela et le rectangle de base
le rectangle lui ne change pas (sauf sans les display) c'est ce qui est à l'interieur(la grille qui change)

du coup avec ma fonction de base dont j'ai adapter le visiblerange au lieu de (0)
donne la même chose
c'est dans la shape qu'il faut travailler

ainsi voila comment je place ma shape

Sub test()
    Dim shap As Shape, r As rectanglePlus, z#, vrx As Range
    z = ActiveWindow.Zoom / 100
    Set vrx = ActiveWindow.Panes(1).VisibleRange
    r = GetRectangleVisibleRange ' get le rectangle de base
    'supprime la shape si elle existe
    On Error Resume Next
    ActiveSheet.Shapes("cobaie").Delete
    On Error GoTo 0
    DoEvents
    Set shap = ActiveSheet.Shapes.AddShape(1, 0, 0, r.WidthPoint / z, r.HeightPoint / z)
    With shap
        .Name = "cobaie"
        .Fill.Transparency = 0.9
        .Fill.ForeColor.RGB = vbGreen
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbRed
        .Line.Transparency = 0
        .ZOrder msoSendToBack
        'base
        .Left = .Line.Weight + vrx.Left
        .Top = .Top + .Line.Weight + vrx.Top
        .Width = .Width - (.Line.Weight)
        .Height = .Height - (.Line.Weight)
        'corrections
        .Left = .Left + 1 * Abs(Not ActiveWindow.DisplayHeadings)
        .Top = .Top + 1 * Abs(Not ActiveWindow.DisplayHeadings)
       
        .Width = .Width - 1 * Abs(Not ActiveWindow.DisplayHeadings)
        .Width = .Width + .Line.Weight * Abs(.Line.Weight = 1)
        .Width = .Width + ((-3) * Abs(Not ActiveWindow.DisplayVerticalScrollBar) And Application.WindowState = xlMaximized)
        .Width = .Width - 4 * Abs(ActiveWindow.SplitColumn > 0) 'correction splitcolumn
        .Width = .Width + 3 * Abs(ActiveWindow.FreezePanes) 'correction width freezpanes

        .Height = .Height - 4 * Abs(ActiveWindow.SplitRow > 0) 'correction splitrow
        .Height = .Height + 3 * Abs(ActiveWindow.FreezePanes) 'correction height freezpanes
        .Height = .Height - 1 * Abs(Not ActiveWindow.DisplayHeadings)


    End With
End Sub

mais je le redit le rectangle ne change pas même quand on fractionne frezepanes ou même scroll etc....
c'est l'intérieur qui change!!!!!

pour info j'ai réussi a monter une sub récursive qui me liste toutes les fenêtres que forme excel avec un getwindowrect je récupère les rectangles
et à ce jour je n'ai reussi qu'a trouvé le width cohérent exact
fenêtre classe excel7- fenêtre classe nuiscrollbar
ce rectangle se trouve dans les fenêtres qui sont sélectionnées dans la console

sachant que ma shape fait 1163.75 trait sur trait donc -1 pour le trait de la fenêtre parent ce qui nous fait 1162.75
et donc en prenant excel7 - NuiScroolbar - XLCTL j'obtiens 1162.5
1200-21-16.5
là c'est précis
il faut que je mette cette version en place

 

[Dudu2]

A priori mes calculs n'ont pas besoin de tout ça, je vais encore vérifier.
Par contre j'ai une erreur en split que je suis en train de corriger.

 

[patricktoulon]

le splitrow ou splitcolumn ajoute 4 dans leur sens respectifs
par contre si tu fige il faut revenir a 1 donc moins 3