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

 

[TooFatBoy]

J'ai fait tous mes réglages à 100% 96 dpi.

En 125% 120 dpi

J'en connais un qui va être content : il a réussi à te contaminer.

---

Tes tableaux sont super intéressants : il semble y avoir plein d'informations dedans !
As-tu un classeur à fournir pour obtenir ces données, ou est-ce trop tard parce que tu l'as déjà effacé de ton HDD ?

 

[patricktoulon]

ton rect relatif au screen c'est ma méthode avec rangefrompoint ? ou tu fait ca avec api?

 

[Dudu2]

@TooFatBoy,

As-tu un classeur à fournir pour obtenir ces données,

Si tu parles des tableaux des constantes de GetSystemMetrics() le fichier qui les liste est dans le Post #132.

 

[Dudu2]

@patricktoulon,

ton rect relatif au screen c'est ma méthode avec rangefrompoint ? ou tu fait ca avec api?

Dans le Post #123 cité il y a 2 fichiers.
- 1 fichier avec ta méthode que j'ai appelée méthode RangeFromPoint.
- 1 fichier avec ma méthode que j'ai appelée méthode Usable.

Les 2 fichiers sont strictement identiques SAUF pour la recherche du RECT.Right et du RECT.Bottom (relatifs au Screen) où nos méthode diffèrent dans la fonction ExactVisibleRangeRECTToScreen().

D'ailleurs j'aurais dû faire 1 seul fichier avec le choix de la méthode en paramètre ou en Constant de compilation.

 

[patricktoulon]

re

Tes tableaux sont super intéressants : il semble y avoir plein d'informations dedans !
As-tu un classeur à fournir pour obtenir ces données, ou est-ce trop tard parce que tu l'as déjà effacé de ton HDD ?

me semble t il l'avoir déjà donné

 

[patricktoulon]

re
moi je vois ca dans ton module et ca c'est ma méthode pour déterminer le rectangle réécrite a ta sauce
c'est quoi ta méthode rangefrompoint relatif au screen?

'-----------------------------------------------
'Exact Visible Range RECT relative to the Screen
'-----------------------------------------------
Function ExactVisibleRangeRECTToScreen(Window As Window) As RECT
    Dim EVRRS As RECT
    Dim LastVisibleRangeCell As Range
    Dim LastXPixelVisible As Long
    Dim LastYPixelVisible As Long
    
    With Window.Panes(Window.Panes.Count)
        Set LastVisibleRangeCell = .VisibleRange.Cells(.VisibleRange.Cells.Count).Offset(-1, -1)
        LastXPixelVisible = .PointsToScreenPixelsX(LastVisibleRangeCell.Left)
        LastYPixelVisible = .PointsToScreenPixelsY(LastVisibleRangeCell.Top)
    
        EVRRS.Left = .PointsToScreenPixelsX(.VisibleRange.Left)
        
        Do While Not .Parent.RangeFromPoint(LastXPixelVisible, LastYPixelVisible) Is Nothing
            LastXPixelVisible = LastXPixelVisible + 1
        Loop
        LastXPixelVisible = LastXPixelVisible - 1
            
        EVRRS.Right = LastXPixelVisible + 1
                
        EVRRS.Top = .PointsToScreenPixelsY(.VisibleRange.Top)
        
        Do While Not .Parent.RangeFromPoint(LastXPixelVisible, LastYPixelVisible) Is Nothing
            LastYPixelVisible = LastYPixelVisible + 1
        Loop
        LastYPixelVisible = LastYPixelVisible - 1
    
        EVRRS.Bottom = LastYPixelVisible + 1
    End With
    
    'Return value
    ExactVisibleRangeRECTToScreen = EVRRS
End Function

 

[Dudu2]

Voilà, j'ai fait ce fichier unique où la méthode est paramétrable.

 

[Dudu2]

me semble t il l'avoir déjà donné

Tu n'as toujours pas corrigé le Return de cette fonction qui doit être un Long en 64bits aussi.

 

[patricktoulon]

re
j'ai ajouté le calcul en point pour les deux
vous avec le descriptif dans celui là c'est ça qui est bien

 

[patricktoulon]

re je viens ré examiner ton fichier @Dudu2
j'aurais une question
je me demandais ce que tu cherchais a faire en ayant en ayant récrit ma méthode trottitrota
( et oui on trotte tant que les points ne donne pas nothing)
alors tel que tu la modifié si tu a des fractions ou figé ben tu va avoir des surprises (j'ai testé bien évidemment)pour confirmer ce que je pensais déjà

pour info; la dernière cellule de la dernière pane est toujours accessible parle visiblerange de la window tout court
pas la peine d'aller chercher une pane

 

[Dudu2]

Ça te plait mieux comme ça ?
J'ai pris la dernière cellule de la dernière Pane pour éviter de mouliner pixel par pixel pour chercher quand ça sort du VisibleRange. En partant de la 1èr Pane on est beaucoup plus loin des bords.

'-----------------------------------------------
'Exact Visible Range RECT relative to the Screen (Method RangeFromPoint)
'-----------------------------------------------
Function ExactVisibleRangeRECTToScreen_RangeFromPoint(Window As Window) As RECT
    Dim EVRRS As RECT
    Dim LastVisibleRangeCell As Range
    Dim LastXPixelVisible As Long
    Dim LastYPixelVisible As Long
    
    With Window.Panes(1)
        EVRRS.Left = .PointsToScreenPixelsX(.VisibleRange.Left)
        EVRRS.Top = .PointsToScreenPixelsY(.VisibleRange.Top)
    End With
    
    With Window.Panes(Window.Panes.Count)
        Set LastVisibleRangeCell = .VisibleRange.Cells(.VisibleRange.Cells.Count).Offset(-1, -1)
        LastXPixelVisible = .PointsToScreenPixelsX(LastVisibleRangeCell.Left)
        LastYPixelVisible = .PointsToScreenPixelsY(LastVisibleRangeCell.Top)
        
        Do While Not .Parent.RangeFromPoint(LastXPixelVisible, LastYPixelVisible) Is Nothing
            LastXPixelVisible = LastXPixelVisible + 1
        Loop
        LastXPixelVisible = LastXPixelVisible - 1
            
        EVRRS.Right = LastXPixelVisible + 1
        
        Do While Not .Parent.RangeFromPoint(LastXPixelVisible, LastYPixelVisible) Is Nothing
            LastYPixelVisible = LastYPixelVisible + 1
        Loop
        LastYPixelVisible = LastYPixelVisible - 1
    
        EVRRS.Bottom = LastYPixelVisible + 1
    End With
    
    'Return value
    ExactVisibleRangeRECTToScreen_RangeFromPoint = EVRRS
End Function

 

[Dudu2]

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

 

[patricktoulon]

tu ne m'a pas compris regarde si j'ai des figé

 

[Dudu2]

Mais parce que j'ai bugué sur les .Left et .Top qui doivent évidemment être pris du Pane(1) que j'avais oublié de remettre. Je t'ai envoyé la correction en #146 et #147 que tu n'as pas pris en compte évidemment.

Quant au parcours des pixels, il faut bien sûr le faire à partir de la dernière Pane et pas de la 1ère.
J'espère que t'as compris ça. Fait 4 Panes et affiche l'adresse de la dernière cellule du 1er et du dernier et tu comprendras.

Merci de me redonner ton code pour l'exploitation d'un RangeFrompoint que je n'aurais pas compris.
Tu me prends pour une bille ou quoi ?

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 - Pour faire la correction du pixel qui manque par rapport au UsableWidth/Height
3 - Pour partir de la dernière cellule de la dernière Pane pour éviter des boucles inutiles
4 - Pour 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.

Après, la Shape en mode fractionné, elle est cassée sur les Panes, c'est normal.
Mais ce qui compte ce sont les dimensions obtenues que les boutons permettent d'obtenir et qui sont correctes.

 

[patricktoulon]

re

Quant au parcours des pixels, il faut évidemment le faire à partie de la dernière Pane et pas de la 1ère.
J'espère que t'as compris ça. Fait 4 Panes et affiche l'adresse de la dernière cellule du 1er et du dernier et tu comprendras.

faut pas oublier que c'est moi qui t' ai donné cette astuce
donc celui qui sait le mieux c'est moi je pense
le problème (que tu a certainement corrigé c'est que les point 0 left et top tu les prenais sur la dernière pane
d'autre part c'est loin d être terminé selon fraction avec figé ou pas les cotes changent
c'est d'ailleurs un fait troublant étant donner que l'on trotte pour aller chercher les derniers pixels
on ne devrait pas avoir a soustraire pour les fraction et figé car le trottinette fait abstraction de tout
on teste un point x,y avec rangefrompoint c'est tout
il y a encore bien des secrets a soulever