XL 2016 Window.PointsToScreenPixelsX vs Pane.PointsToScreenPixelsX

Lu76Fer

XLDnaute Occasionnel
Sujet : éclaircir la différence existant entre ces deux fonctions appartenant à 2 objets différents
Bien-sûr il y a aussi la fonction PointsToScreenPixelsY et c'est le pendant pour calculer l'ordonnée d'un point sur la grille, sur l'écran.
En faite, la fonction Pane.PointsToScreenPixelsXouY est apparue dans la version d'Excel 2007, sous 2003 il n'y avait que Window.PointsToScreenPixelsX ouY et il est resté par soucis de compatibilité ascendante.

Window.PointsToScreenPixelsX : cette fonction permet de calculer la position sur l'écran d'une grandeur sur la grille Range.Top ou Range.Left, sur l'écran en travaillant sur l'ActivePane. Il s'agit du volet actif et il peut y en avoir 4,2 ou 1 selon le nombre de séparateur ... Cette fonction ne tient pas compte du Zoom sur la grille et même avec un zoom à 100% donne une position approximative ?!? En faite la seule information utile que peut donner cette fonction c'est pour la position du Volet Actif :

VB:
x = ActiveWindow.PointsToScreenPixelsX(0)
y = ActiveWindow.PointsToScreenPixelsY(0)
Cela peut vous permettre de connaitre la position de la grille mais de façon très indirecte ... Il faut être sur le volet 1 et avoir la cellule A1 visible dans celui-ci.

Pane.PointsToScreenPixelsX : cette fonction fait la même chose sur le volet Pane, tient compte du zoom et donne la position exacte !


Conclusion : n'utilisez pas ActiveWindow.PointsToScreenPixelsXouY mais ActiveWindow.Panes(i).PointsToScreenPixelsXouY si vous ne souhaitez pas vous prendre inutilement le choux !
 

Dudu2

XLDnaute Barbatruc
Il y a pas mal de temps, j'avais comparé l'exécution API directe et via ExecuteExcel4Macro et avais remarqué une différence de CPU sans plus m'attarder sur la question et en privilégiant l'API dans mon code.

Mais là ce qui est embêtant c'est que le temps augmente à chaque appel d'ExecuteExcel4Macro ce qui exclut de l'utiliser dans des boucles.

Ici on peut s'en sortir en ne l'exécutant qu'une fois et en gardant la valeur dans un Static qui sera rendu aux exécutions suivante. Mais cela remet en cause la généralisation de l'utilisation de ExecuteExcel4Macro.
 

Dudu2

XLDnaute Barbatruc
Ce n'est pas spécifiquement lié à ExecuteExcel4Macro car dans ce cas, il n'y a pas d'incrémentation du temps.
VB:
Sub Test()
    Dim t As Single
    Dim d As Double
    Dim i As Integer
    
    t = Timer
    For i = 1 To 1000
        Call ExecuteExcel4Macro("GET.CELL(42)")
    Next i
    
    MsgBox "Temps = " & Format(Timer - t, "0.00")
End Sub
 

Dudu2

XLDnaute Barbatruc
Mais là, oui, ça augmente.
Code:
Sub Test()
    Dim t As Single
    Dim d As Double
    Dim i As Integer
    
    t = Timer
    For i = 1 To 1000
        'Call ExecuteExcel4Macro("GET.CELL(42)")
        Dim DC As Long
        DC = ExecuteExcel4Macro("CALL(""user32"",""GetDC"",""JJJ"",0)")
    Next i
    
    MsgBox "Temps = " & Format(Timer - t, "0.00")
End Sub
 

Dudu2

XLDnaute Barbatruc
Bonjour à tous,

@patricktoulon, si tu parles de ton fichier du Post #28, je ne comprends pas pourquoi tu as fait un truc alambiqué avec des cellules et un UserForm en Move, plus une boucle de 3/10ème de DoEvents inclus dans le traitement dont la CPU du temps global n'est pas compté, le tout dans une boucle qui tourne 20 fois quand dans mon exemple ça tourne 1000 fois. Tu ne peux tirer aucune conclusion de ce truc étrangement sophistiqué concernant la CPU du ExecuteExcel4Macro.

Alors je sais que j'ai mis bien involontairement et à regret un caillou dans ta chaussure de spécialiste du ExecuteExcel4Macro en remplacement de l'API, mais il y a manifestement un souci qu'il semble difficile de régler. Ce qui n'exclue pas son usage mais en connaissance de cause car le temps unitaire reste minime.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
non t'inquiet j'ai les semelles dures
en effet il y a un effet de masse
mais entre nous comme tu l'a déjà dis avec une variable static ca fera très bien l'affaire
surtout que je ne vois pas l'intérêt de calculer1000 fois le point to pixel avec les api (en macro4 ou pas)

VB:
Sub test1()    'avec les api en macro4
    MsgBox PtsToPx
End Sub

Function PtsToPx()
    Static px#: Dim Dc&
    If px = 0 Then
        Dc = ExecuteExcel4Macro("CALL(""user32"",""GetDC"",""JJJ"",0)")
        px = ExecuteExcel4Macro("CALL(""gdi32"",""GetDeviceCaps"",""JJJ""," & Dc & ", " & 88 & ")") / 72
    End If
    PtsToPx = px
End Function
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
tiens au fait
une fonction getpane absolue
fonctionne sur fractionnée et figée
VB:
Sub testxw1()
    MsgBox GetPaneOfObject2(ActiveSheet.Shapes(1)).Index
End Sub
Function GetPaneOfObject2(obj As Object) As Pane
   Dim X&
   With ActiveWindow
        x = 1
        If .Panes.Count > 1 Then
            If obj.Left > .Panes(1).VisibleRange.Width Then x = x + 1
            If obj.Top > .Panes(1).VisibleRange.Height Then x = x + 1
            If .Panes.Count = 4 Then
                If obj.Top > .Panes(1).VisibleRange.Height Then x = x + 1
            End If
        End If
        Set GetPaneOfObject2 = .Panes(x)
    End With
End Function
tu me diras ce que tu en pense

même si on scroll et que l'on vois plus l'object ca te donne quand même la bonne pane
 

Dudu2

XLDnaute Barbatruc
A la première lecture, la faille est évidente.
Si tu testes par rapport au VisibleRange des Panes t'es foutu.

1692616603404.png
 

Pièces jointes

  • Classeur3.xlsm
    21.5 KB · Affichages: 5

Dudu2

XLDnaute Barbatruc
Voilà un code qui utilise Obj.Left et Obj.Top.
Avec un Select Case c'est plus joli

Code:
Function GetPaneOfObject3(Obj As Object) As Pane
    Dim Pan As Pane
    Dim FreezeCell As Range
  
    With ActiveWindow
        'https://www.mrexcel.com/board/threads/vba-how-do-i-figure-out-what-cell-at-which-panes-are-frozen-with-freezepanes.1129717/
        Set FreezeCell = ActiveSheet.Cells(.Panes(1).ScrollRow + .SplitRow, .Panes(1).ScrollColumn + .SplitColumn)

        Select Case .Panes.Count
            Case 1
                Set Pan = .Panes(1)
              
            Case 2
                'Split sur une ligne
                If FreezeCell.Column = 1 Then
                    If Obj.Top < FreezeCell.Top Then Set Pan = .Panes(1) Else Set Pan = .Panes(2)
                  
                'Split sur une colonne
                Else
                    If Obj.Left < FreezeCell.Left Then Set Pan = .Panes(1) Else Set Pan = .Panes(2)
                End If
      
            Case 4
                'Dans les 2 premiers Panes
                If Obj.Top < FreezeCell.Top Then
                    If Obj.Left < FreezeCell.Left Then Set Pan = .Panes(1) Else Set Pan = .Panes(2)
              
                'Dans les 2 derniers Panes
                Else
                    If Obj.Left < FreezeCell.Left Then Set Pan = .Panes(3) Else Set Pan = .Panes(4)
                End If
        End Select
    End With
      
    'Return Value
    Set GetPaneOfObject3 = Pan
End Function
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
je ne sais pas ni ou ni comment tu l'a testé mais chez moi
Je t'ai mis le fichier en Post #40 pour que tu reproduises, c'est pas sorcier. <Ctrl + w> pour lancer ta macro.
Ce fichier contient ton code et une Shape en Panes(2) hors du VisibleRange.

De toutes façon, rien qu'à faire référence au Panes(x).VisibleRange, on sait d'avance que ça peut pas marcher.
 

patricktoulon

XLDnaute Barbatruc
le principe de mon model est simple
la panes(1) a un width et un height (toujours le même scrollé ou pas)
le left d'un object par de la colonne A(toujours)
donc
si le left de l'object(ça peut être un range) plus grand que le width de la panes(1) alors on ajoute 1 à x
si le top de l'object(ça peut être un range) plus grand que le height de la panes(1) alors on ajoute 1 à x

et si il y a 4 panes
on reteste une nouvelle fois le top de l'object
terminé tu a ta panne absolue

et pour info même scrollé avec shapeinvisible mon teste userform fonctionne
regarde
demo.gif
 

Statistiques des forums

Discussions
315 092
Messages
2 116 118
Membres
112 665
dernier inscrit
JPHD