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]

Allez kado de la part du copain
@Dudu2 tu me dira pas dans un an ou deux que je te l'avais pas dit
j'attire ton attention sur les deux derniers msgbox qui confirme ce que je te disais il y a plus de 3 ans maintenant qu'avec getsytemmetrics selon les index il faut diviser ou multiplier par 2

#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetSystemMetricsForDpi Lib "user32" (ByVal nIdx As Long, ByVal lDPI As Long) As Long
    Private Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetSystemMetricsForDpi Lib "user32" (ByVal nIdx As Long, ByVal lDPI As Long) As Long
    Private Declare Function GetDpiForWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If

Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYDLGFRAME = 8
Private Const SM_CXSIZEFRAME = 32

Sub test2()
    MsgBox "Dpi simulé pour la fenêtre par Windows : " & GetDpiForWindow(Application.hWnd)
    MsgBox "largeur de scrollbar :" & GetSystemMetricsForDpi(SM_CXVSCROLL, GetDpiForWindow(Application.hWnd))

    MsgBox " Largeur des bordures avec DPI full :" & GetSystemMetricsForDpi(SM_CXSIZEFRAME, GetDpiForWindow(Application.hWnd))
    MsgBox " Largeur des bordures sans DPI full :" & GetSystemMetrics(SM_CXSIZEFRAME)
End Sub

oserais je dire aussi que nous avons là une énième solution pour le Point to pixel

Sub test3()
MsgBox " ptopx :" & PointsToPixel & vbCrLf & "soit l'inverse :" & 1 / PointsToPixel
End Sub

Function PointsToPixel()
PointsToPixel = GetDpiForWindow(Application.hWnd) / 72
End Function

le copain qui n'a rien compris au DPI

 

[TooFatBoy]

C'est trop compliqué pour moi.

Oui, pour moi aussi.

Et pour tout le monde également je crois, car personne ne sait expliquer pourquoi Excel me dit que je suis en 96 dpi alors qu'en réalité je suis en 111 dpi.
J'avais supposé que ça venait du zoom de Windows : 96 dpi pour 100 %, 192 dpi pour 200 %, etc. (oui, "ça marche à l'envers), mais ton pote m'avais dit que ça n'avait rien à voir.

Du coup je reste toujours bloqué là-dessus.

 

[Dudu2]

GetDpiForWindow(

Belle trouvaille ! Ça me plait bien car API et peu de code !

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

Function PointToPixel() As Double
    With Application
        PointToPixel = GetDpiForWindow(.hwnd) / .InchesToPoints(1)
    End With
End Function

Function PixelToPoint() As Double
    PixelToPoint = 1 / PointToPixel
End Function

 

[patricktoulon]

re
@Dudu2
ben en fait je les ai depuis un moment déjà, j'ai juste la flemme de convertir mes code C# en vba
j'ai des centaines de pépites comme ça en C#

@TooFatBoy à m'ignorer plutôt que de s’adresser à moi ben tu passe à coté
vous raisonnez purement mathématique par rapport a votre plaque (écran)
alors que je vous parle d’échelle et simulation appliqués par windows
d'autant plus que comme je l'ai dit encore une fois
il y a deux gestion graphique
1°par windows générique
2°par les drivers carte graphique

si windows te dit que ton carré est un rectangle c'est un rectangle et tu fait les calcul avec un rectangle même si a l'écran tu vois un carré et l'inverse et valable également

 

[Dudu2]

Chez moi ça cadre bien dans tous les cas, sauf avec du Zoom que je n'arrive pas à gérer.
Je crains que chez @patricktoulon, va encore y avoir des problèmes de cadrage bas en fenêtre réduite, à vérifier.
@TooFatBoy, tu peux essayer STP ?

J'ai introduit le traitement (en pixels) des bordures en horizontal mais pas en vertical sinon chez moi ça décale.

    With RVR
        .Left = Window.VisibleRange.Left * PointToPixel / Zoom
  
        .Right = .Left _
                 + (RW.Right - RW.Left) / Zoom _
                 + VerticalBorderWidth _
                 - GetVerticalHeadingsWidthPixels(Window) _
                 - IIf(Not Window.WindowState = xlMaximized, RightFrameWidth, 0) _
                 - IIf(Application.DisplayScrollBars, VerticalScrollBarWidth, 0)
                          
        .Top = Window.VisibleRange.Top * PointToPixel / Zoom
  
        .Bottom = .Top _
                  + (RW.Bottom - RW.Top) / Zoom _
                  - GetRibbonAndHorizontalHeadingsHeightPixels(Window) _
                  - IIf(Not Window.WindowState = xlMaximized, BottomFrameWidth, 0) _
                  - IIf(Application.DisplayScrollBars, HorizontalScrollBarHeight, 0) _
                  - IIf(Application.DisplayStatusBar, StatusBarHeight, 0)
    End With

 

[patricktoulon]

re
un outils qui pourrais te servir dans tes futurs devo en pièce jointe

test du post #35
mode fullscreen
trop a droite pas assez en bas

mode fenêtre
a droite je pense que c'est bon en bas pas assez

 

[TooFatBoy]

@TooFatBoy, tu peux essayer STP ?

Avec plaisir.

Pour #3( c'est :
- carré jaune un pixel trop haut en fenêtre flottante,
- carré jaune un pixel trop à droite en plein écran.

 

[TooFatBoy]

J'attends vos retours pour valider, @TooFatBoy, @sylvanu, @patricktoulon.

Pour #20, c'était :
- 2 pixels trop haut et 1 pixel trop à gauche en fenêtre flottante,
- parfait en plein écran.

 

[Dudu2]

Private Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

Faut pas que tu lui fasses retourner un LongPtr, incompatibilité de type. Un Long ça va mieux.

Je m'étais fait un truc similaire.

 

[TooFatBoy]

Faut pas que tu lui fasses retourner un LongPtr, incompatibilité de type. Un Long ça va mieux.

Je n'ai touché à rien, j'ai juste testé tes classeurs.

 

[Dudu2]

Je n'ai touché à rien, j'ai juste testé tes classeurs.

C'est pour @patricktoulon dans le code de son fichier du Post #36.

 

[Dudu2]

Je pense que ça ira chez vous, mais ça ne va pas chez moi en fenêtre réduite car l'ajout de la BORDER qui devrait régler le problème chez vous, me fait dépasser les limites.

Quelle est la différence entre nos config ? Comment identifier ce qui fait la différence ?

 

[TooFatBoy]

C'est pour @patricktoulon dans le code de son fichier du Post #36.

Ah bon. Au temps pour moi alors.

 

[TooFatBoy]

Je pense que ça ira chez vous, mais ça ne va pas chez moi en fenêtre réduite car l'ajout de la BORDER qui devrait régler le problème chez vous, me fait dépasser les limites.

Avec #42 : un "tout petit" pixel trop haut... autrement dit, précédemment ça devait être deux pixels trop haut et non un seul.

Parfait en plein écran.

 

[TooFatBoy]

#20​	#35​	#42​
​	​	​