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:

patricktoulon

XLDnaute Barbatruc
Bonjour
Test du #90
en maximisé sans la scrollbar vertical j'ai l’épaisseur du contour de shape en trop
mais tu n'y peux rien car selon l’épaisseur du cadre de la shape il faut enlever ou pas et ce n'est pas régulier

Comme tu peux le voir dans cette capture selon l’épaisseur ca mange vers l’intérieur ou vers l’extérieur
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Comme tu peux le voir dans cette capture selon l’épaisseur ca mange vers l’intérieur ou vers l’extérieur
ah ouais, ça c'est emm*erdant. On ne sait pas où est le cadre finalement.
De toutes façons je suis en train de regarder, il y a des micro-variations selon que le Headings sont là ou pas.
 

Dudu2

XLDnaute Barbatruc
Remarque très judicieuse sur l'épaisseur du trait que j'avais supposé intérieure à la Shape !
En fait pour avoir la Shape bien cadrée (épaisseur du trait = 0 et sélection pour la voir) il faut que chez moi j'apporte ces corrections par rapport au RECT du Screen, c'est à dire des CXEDGE/CYEDGE.
VB:
    With Window.Panes(1)
        EVRRW.Left = EVRRS.Left - .PointsToScreenPixelsX(0) + CXEDGE
        EVRRW.Right = EVRRS.Right - .PointsToScreenPixelsX(0) + CXEDGE
        EVRRW.Top = EVRRS.Top - .PointsToScreenPixelsY(0) + CYEDGE
        EVRRW.Bottom = EVRRS.Bottom - .PointsToScreenPixelsY(0) + CYEDGE
    End With

Et dans tous les cas j'obtiens cette sélection de Shape avec des demi-cercles sur se bordures.
Finalement ni les Scroll Bars ni la Status Bar ni les Headings n'influent sur les valeurs.

 
Dernière édition:

Dudu2

XLDnaute Barbatruc
A la recherche de la perfection (qui n'est pas de ce monde) !
Hélas, chez moi, les Headings ont une micro-influence (1 pixel) sur le Right et c'est embêtant car ça fait une exception dans cette correction.
VB:
    With Window.Panes(1)
        EVRRW.Left = EVRRS.Left - .PointsToScreenPixelsX(0) + CXEDGE
        'EVRRW.Right = EVRRS.Right - .PointsToScreenPixelsX(0) + CXEDGE
        EVRRW.Right = EVRRS.Right - .PointsToScreenPixelsX(0) + IIf(Window.DisplayHeadings, CXEDGE, CXBORDER)
        EVRRW.Top = EVRRS.Top - .PointsToScreenPixelsY(0) + CYEDGE
        EVRRW.Bottom = EVRRS.Bottom - .PointsToScreenPixelsY(0) + CYEDGE
    End With
 

Pièces jointes

  • ExactVisibleRangeSize.xlsm
    54.5 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
re
oui j'ai remarqué tout ça cette nuit
ça m'a filer l'ambouligue il fallait que je trouve
et je te parle même pas si excel n'est pas en zoom 100(surprise surprise)
alors tu va raboter ou allonger et chez toi ça va être impec et chez un autre un peu moins
en fait je le redit ce que vous voyez à l'écran ne reflète qu' approximativement les calculs
c'est windows qui adapte son echelle ""DPI""(je le met entre guillemet hein )

la meilleur c'est celle que je t'ai donné en premier ou l'on touche a rien( la shape tel quel)
car des qu'on touche au bordures etc... c'est mort selon les display

cela dit même si la shape n'est pas tout a fait bien , le return des coordonnées rangefrompoint te donnent les valeurs exactes
et c'est ce qui compte finalement
 

Pièces jointes

  • copie Get Real visible range patricktoulon.xlsm
    31.3 KB · Affichages: 1
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
en fait la bordure de la shape est au milieu
si elle fait 1 c'est 0.5 dedans 0.5 dehors
si c'est 2 c'est un dedans 1 dehors
sauf que d'es que l'on touche selon les écran Windows va adapter pour que tu vois la bordure
et du coup visuellement le mezo/mezo va se transformer en 1tier ou 2/tiers

je réussi a le voir quand je me met en mode 4k 1080p
ca me parait difficile de corriger ça
parti de là à 1 point près toute nos version et méthodes sont valables
je préfère ma méthode non pas par ce que c'est la mienne mais par ce que on fait appel a des objects que l'on maitrises, donc pas d'api pas de chichipanpan

on prend une cellule (-1 ligne du bottom,-1colonne du right)et on trotte(avec +1pixel) avec les cordonnée s pixel dans rangefrompoint jusqu’à nothing et terminé on ne peut être plus exact que ça
 

Dudu2

XLDnaute Barbatruc
Non mais ok pour ce que j'ai appelé le ExactVisibleRangeRECTToScreen, aucune correction.
Si tu dois positionner un Objet (genre UserForm) dont le parent n'est pas la feuille, c'est parfait.

Si tu dois positionner un Objet dont le parent est la feuille, tu dois ajuster ces coordonnées pour les rendre relatives à la fenêtre. C'est ma fonction que j'ai appelée ExactVisibleRangeRECTToWindow qui doit au minimum subir la correction du PointsToScreenPixelsX/Y(0), c'est obligatoire.

Après viennent des corrections additionnelles qui peuvent ne pas convenir à toutes les configs. J'ai appliqué les corrections additionnelles qui conviennent à ma config.
Sans ces corrections additionnelles, on obtient ce que ton code donne chez moi, c'est à dire un cadre qui dépasse les limites du VisibleRange. C'est un choix.



Maintenant j'aimerais bien savoir ce que donne mon code qui a ces corrections additionnelles sur ta config avec un screenshot. Et éventuellement chez @TooFatBoy.
 

patricktoulon

XLDnaute Barbatruc
un poil pas assez à gauche et 2 poils trop a droite en mode maximisé fullmenustem
quoi que avec la selection on pas bien


bon a gauche 2 poila de trop en bas 2 poils de trop a droite
en mode maximisé sans tout les menu du system


en mode fenêtré sans les menus system
pareil a une echelle différente


en mode fenêtré avec les menusystem
pareil


autrement dit on ne voit que la bordure rouge (gauche et top )
 

Dudu2

XLDnaute Barbatruc
En fait ton code fonctionne quand je suis en échelle 100%.


Dès que je passe en 125% ça déborde alors que mon code fonctionne dans les 2 cas.
On n'a pas la même approche du calcul de ce cadre.
 

Dudu2

XLDnaute Barbatruc
autrement dit on ne voit que la bordure rouge (gauche et top )
Les bordures rouges, suite à ta remarque tout à fait justifiée sur les épaisseurs, j'ai abandonné, tu les as remis ou pas pris le fichier du #95.
Ce qui compte ce sont les demi-cercles de la sélection en Shape.Line.Weight = 0.
 

Dudu2

XLDnaute Barbatruc
Ceci dit, les corrections additionnelles que j'applique sur la base du visuel de ma config sont minimes.
1 pixel (SM_CXBORDER) ou 2 pixels (SM_CXEDGE).
On peut accepter ça comme erreur et considérer l'affaire comme terminée.
Et encore bien joué pour avoir trouvé les limites basses de la partie visible.
 

patricktoulon

XLDnaute Barbatruc
re
limite basse et droite
si j’enlève la bordure a la shape
je vois mes 6 poignées de redimensionnement de la shape

et avec la tienne sans bordure

on a le même defaut sauf que moi c'est à gauche et toi à droite

alors je viens de parler à un collègue de boulot et il m'a expliqué
1 pixel c'est très petit et selon les résolutions +dpi(toujours simulé par windows hein je le redit)
et bien il ne peut pas l'afficher dans excel car on est en point et je parle même pas des calculs qui vont nous donner( x pixels virgule quelque chose) alors excel te l'affiche à 1.25 pixel qui est son minima

et a partir de 1920X1080 se sera 1 point tout court soit 1.33333.... pixel
conclusion on aura jamais le même rendu
car moi je suis en 1600X900 en 1080i
 

Dudu2

XLDnaute Barbatruc
Juste pour finir ma dernière version.
J'ai vérifié en m'assurant de ne pas voir le trait de sélection de la Shape en Shape.Line.Weight = 0 en ajoutant ou supprimant 1 seule pixel aux limites. Si on voit le trait de sélection c'est qu'on est en-dedans.
Donc, chez moi, je ne peux pas faire mieux car ça fonctionne en 100% et 125% d'échelle d'affichage.
 

Pièces jointes

  • ExactVisibleRangeSize.xlsm
    55.1 KB · Affichages: 1

patricktoulon

XLDnaute Barbatruc
re et non line.weight=0 ne fonctionne pas dans le sens ou ça n'enlève pas
en fait il le prend pas
de plus
quand je regarde en zoom 90% que je teste le mien et le tiens cette fois ci on se retrouve avec EXACTEMENT le même defaut c'est à dire que l'on vois pas assez les poignées à droite de redimensionnement de la shape
tu va comprendre fait ce test dans un fichier vierge
VB:
Dim texte
Sub test()
Dim shap As Shape, shap2 As Shape
texte = ""
 Set shap = ActiveSheet.Shapes.AddShape(1, 0, 0, 100, 100)
    With shap
        .Name = "cobaie"
        .Fill.Transparency = 0.9
        .Fill.ForeColor.RGB = vbGreen
        .Line.Visible = msoFalse
        '.Line.Weight = 5
        .Line.ForeColor.RGB = vbRed
        .Line.Transparency = 0
        .ZOrder msoSendToBack
     End With
Set shap2 = ActiveSheet.Shapes.AddShape(1, 0, 102, 100, 100)
    With shap2
        .Name = "cobaie2"
        .Fill.Transparency = 0.9
        .Fill.ForeColor.RGB = vbGreen
        .Line.Weight = 5
        .Line.ForeColor.RGB = vbRed
        .Line.Transparency = 0
        .ZOrder msoSendToBack
    texte = "shape 1.width " & shap.Width & vbCrLf & "shape 2.width " & shap2.Width & vbCrLf & _
     "shape 1.left " & shap.Left & vbCrLf & "shape 2.left " & shap2.Left & vbCrLf & _
     "alors qu'il est clairement visible que la shape 2 est plus grande et a moins de zero de left "
  Application.OnTime Now + 0.00001, "message"
    End With
End Sub
Sub message()
MsgBox texte
End Sub
et il est fort possible que tu n'ai pas le même résultat que celui là
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…