Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 VBA - Exact Visible Range

Dudu2

XLDnaute Barbatruc
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
 
Dernière édition:
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
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
VB: 
#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
VB: 
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
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Dudu2 à dit:
C'est trop compliqué pour moi.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc
GetDpiForWindow(
Cliquez pour agrandir...
Belle trouvaille ! Ça me plait bien car API et peu de code !
VB: 
#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
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc
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.
VB: 
    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
 

Pièces jointes

  • ExactVisibleRangeSize.xlsm
    47.7 KB · Affichages: 4
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 

Pièces jointes

  • getsystemMetrics Controler.xlsm
    26.3 KB · Affichages: 1
Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc
VB: 
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.
 

Pièces jointes

  • GetSystemMetrics.xlsm
    30.7 KB · Affichages: 0
Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc
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 ?
 

Pièces jointes

  • ExactVisibleRangeSize.xlsm
    47.8 KB · Affichages: 1
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Dudu2 à dit:
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.
Cliquez pour agrandir...
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.
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…