XL 2016 VBA - Calcul des hauteur et largeur des Headings (pour les forts en thème)

Dudu2 · 20 Octobre 2024

Bonjour,

J'ai fait un code qui permet de calculer (du moins je le pense) la hauteur du Heading horizontal et la largeur du Heading vertical.
Ce calcul fonctionne apparemment bien en toutes occasions...SAUF SI le Zoom n'est pas à 100% ET QUE le ScrollRow ou le ScrollColumn ne sont pas à 1.

Je me suis cassé les dents sur ce calcul pour trouver la cause du non fonctionnement sous cette condition que j'ai contourné par un Scroll en 1/1 (A1) sous ScreenUpdating = False.
Mais évidemment ce n'est pas très satisfaisant.

Pour tester le calcul qui foire sans le Scroll salvateur, modifier la constante pré-processeur à #Const USE_SCROLL = False

Attention ! Le facteur Zoom n'a pas à être introduit dans le calcul actuel car aussi bien PointsToScreenPixelsX/Y que VisibleRange.Left/Top tiennent déjà compte du Zoom.
Sous un zoom donné il y a une progression du décalage proportionnelle à la Width des colonnes et la Height des lignes prédédant la 1ère cellule du VisibleRange.
Je n'ai pas trouvé les éléments de calcul qui permettraient de les déterminer. C'est du lourd !

patricktoulon · 21 Octobre 2024

VB:

Sub test()
    With ActiveWindow.Panes(1)
        p1 = .PointsToScreenPixelsX(.Parent.VisibleRange.Cells(1).Left) * 0.75
    p1 = p1 - (Application.Left * Abs(Application.Left > 0))
    End With
MsgBox "les heading mesurent " & p1 & " Points"
End Sub

patricktoulon · 20 Octobre 2024

re
bon soir @Dudu2
pointstoscreenpixelsx ou y(0) te donne le point zero de la grille (zoom ou pas zoom)
ben il ne te reste plus qua soustraire l'app.left pour X et app.top pour y tu aura ton bandeau(pas le heading)
en convertissant les point x et y bien sur avant la soustraction
les heading c'est les lettres colonne et numero de ligne

commandbars(ribbon").height te donne le ruban plus la barre de formule (depuis indissociable office2010)
les onglets c'est commandbars(1).height

Dudu2 · 21 Octobre 2024

Salut @patricktoulon,

Merci pour ces précisions. Je vais renommer le truc pour inclure la bandeau.

L'Application.Left/Top je ne sais pas trop ce que c'est, ça ressemble à l'ActiveWindow.Left/Top.
En fait j'utilise une fonction GetWindowExactRECT(Window) qui me donne l'exact RECT en pixels de la fenêtre pour éviter ces -4.4 points que je n'ai jamais compris quand la fenêtre est maximisée.
Ces -4.4 points, on ne sait pas si c'est à cause de la maximisation ou de la position réelle qui serait par hasard -4,4 points. Ma fonction donne 0 (pixels) quand la fenêtre est maximisée et un RECT parfaitement exact pour la fenêtre.

Le problème que j'ai soulevé est ailleurs. Il y a un écart qui se créé dans le calcul quand Zoom <> 100 ET qu'on n'est pas en A1.
- En X il est proportionnel à la taille des colonnes précédant le VisibleRange.Left (pareil symétrie en Y sur .Top)
- Il est égal à zéro quand le zoom est 100% => peut-être un facteur (100 - ActiveWindow.Zoom) à introduire quelque part.

patricktoulon · 21 Octobre 2024

bonsoir
quand l'app est maximisé le top est à -3et pas à zero
-3 plus la bordure de 1.2(4) ben ca fait 4.2(4)
tu n'a qua regarder la doc sur l'api getsytemmetric tu a tout déjà dedans
re

- En X il est proportionnel à la taille des colonnes précédant le VisibleRange.Left (pareil symétrie en Y sur .Top)

patricktoulon · 21 Octobre 2024

VB:

Sub test()
    With ActiveWindow.Panes(1)
        p1 = .PointsToScreenPixelsX(.Parent.VisibleRange.Cells(1).Left) * 0.75
    p1 = p1 - (Application.Left * Abs(Application.Left > 0))
    End With
MsgBox "les heading mesurent " & p1 & " Points"
End Sub

Dudu2 · 21 Octobre 2024

Ok, ce calcul a l'air de fonctionner.
Je l'avais évidemment essayé mais c'est le Panes(1) qui change tout !
Et je me demande bien pourquoi.

patricktoulon · 21 Octobre 2024

ben maintenant tu sait comment faire avec Y et comment prendre la mesure du bandeau complet

Dudu2 · 21 Octobre 2024

Bien trouvé @patricktoulon, ce Panes(1) est salutaire ! (sans que je comprenne vraiment pourquoi )
D'où la nouvelle version du code.

patricktoulon · 21 Octobre 2024

re
pourquoi panes(1)?
et pas activepane par exemple
et bien tout simplement (déjà dit) que

1° si tu a une feuille fractionné tu n'est peut être pas sur la bonne panne
pourquoi pas la bonne pane?
et bien tout simplement tu prends le points(0) en haut à gauche de la grille on est donc FORC2MENT dans la panes(1)

2° si tu est sur une feuille avec figé (colonne ou ligne)la panes (1) n'est pas accessible par excel c'est a dire que si tu fait par exemple msgbox activepane.index il te donnera la première qui est libre tout simplement parce que les figée ne peuvent pas être une pane active

c'est plus clair là ?

Dudu2 · 21 Octobre 2024

Ça j'avais compris pourquoi Panes(1).
Ce que je n'ai pas compris c'est pourquoi ça ne marche pas avec
With ActiveWindow
et que ça marche avec
With ActiveWindow.Panes(1)

patricktoulon · 21 Octobre 2024

par ce que depuis office2007 activewindow ne gère le ".PointsToScreenpixel uniquement par rétrocompatibilité c'est depuis 2007 que MS a introduit le fractionnement et le volet figé avant sur excel 2003 ça n'existait pas

en gros maintenant activewindow.PointsToscreenPixels ne veut plus rien dire

patricktoulon · 22 Octobre 2024

voila le resultat avec ton nouveau fichier

et voila la même chose avec ce code

VB:

Sub test()
    With ActiveWindow.Panes(1)

        p1 = .PointsToScreenPixelsX(.Parent.VisibleRange.Cells(1).Left) * 0.75
        p1 = p1 - (Application.Left * Abs(Application.Left > 0))

        p2 = .PointsToScreenPixelsY(.Parent.VisibleRange.Cells(1).Top) * 0.75
        p2 = p2 - (Application.Top * Abs(Application.Top > 0))


    End With

    MsgBox "les heading mesurent " & p1 & " Points" & vbCrLf & _
            "mon badeau complet fait " & p2 & " Points"
    
    With UserForm1
        .Show 0
        .Left = p1 + (Application.Left * Abs(Application.Left > 0))
        .Top = p2 + (Application.Top * Abs(Application.Top > 0))

    End With
End Sub

Dudu2 · 22 Octobre 2024

Oui, à 2 différences près sur le calcul.
- Je calcule la conversion pixels / points avec des fonctions qui utilisent l'API (au final c'est la méthode la plus sûre). 0.75 c'est chez toi et tu sais que chez moi c'est 0.6.
- Je calcule le RECT excat de la fenêtre, toujours via une fonction généraliste dédiée, pour éviter ces -4.4 chez moi (-3 chez toi ?).

Et 1 différence près sur le résultat.
Dans le cas d'une fenêtre réduite et + ou - décalée à gauche, tes dimensions de headings sont fausses à cause de ces fichus Application.Left/Top dont il faut corriger les effets pervers en maximisation. D'où ma fonction GetWindowExactRECT() qui règle ce problème définitivement et dont je me sers tout le temps pour déterminer la position d'une fenêtre.

Dudu2 · 22 Octobre 2024

Encore qu'avec ton calcul basé sur sur Application.Left/Top (ou ActiveWindow.Left/Top) on peut s'en sortir en utilisant le .WindowState. Je n'y avais pas pensé jusque là.

VB:

Sub test()
    Dim p1 As Double
    Dim p2 As Double
 
    With ActiveWindow
        With .Panes(1)
            p1 = .PointsToScreenPixelsX(.Parent.VisibleRange.Left) * 0.6
            p2 = .PointsToScreenPixelsY(.Parent.VisibleRange.Top) * 0.6
        End With
     
        If Not .WindowState = xlMaximized Then
            p1 = p1 - .Left
            p2 = p2 - .Top
        End If     
    End With

    MsgBox "les heading mesurent " & p1 & " Points" & vbCrLf & _
            "mon badeau complet fait " & p2 & " Points"
 
    With UserForm1
        .Show 0
        .Left = p1
        .Top = p2
     
        If Not ActiveWindow.WindowState = xlMaximized Then
            .Left = .Left + ActiveWindow.Left
            .Top = .Top + ActiveWindow.Top
        End If
    End With
End Sub

patricktoulon · 22 Octobre 2024

re
Bonjour @Dudu2
non pas windowstate car tu peux être en fenêtre réduite et être a - X à gauche
je vais voir pour tes résultats négatifs

XL 2016 VBA - Calcul des hauteur et largeur des Headings (pour les forts en thème)

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires