XL 2016 Quoi de moins simple que de déterminer le RECT d'une fenêtre ? Fichier pour test...

Option Explicit

' Déclarations API vba7/vb6
#If VBA7 Then
    'pour 32 et 64
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni 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 SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
    Private Declare Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
#End If

Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type
' Constantes pour SystemParametersInfo pour capter  l'area disponible pour travailler
Private Const SPI_GETWORKAREA As Long = &H30

' Fonction pour obtenir le rectangle de l'espace de travail (excluant la barre des tâches)
' et cela où qu'elle soit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Public Function GetValidAndAvailableRect() As RECT
    Dim screenRect As RECT, AvailableRECT As RECT, app As Application, screenWidth&, screenHeight&, PpX#
    Set app = Application
    '**************************************************************************
    'PpX = 0.75 'utilise ta methode ici pour le coeff pixel/point(moi rien a fout c'est toujours 0.75)
    'allez je fait un effort :):):)
    PpX = GetDpiForWindow(app.hWnd) / 72
    '*******************************************************************************
    'les dimensions de l'écran avec GetSystemMetrics
    screenWidth = GetSystemMetrics(0) ' SM_CXSCREEN
    screenHeight = GetSystemMetrics(1) ' SM_CYSCREEN

    If Application.WindowState = xlMaximized Then
        ' Obtenir les dimensions de l'espace disponible en excluant la barre des tache
        If SystemParametersInfo(SPI_GETWORKAREA, 0, AvailableRECT, 0) <> 0 Then
            GetValidAndAvailableRect = AvailableRECT
        Else
            ' vraiment  pour au cas ou l'appel échoue, retourner l'écran complet
            screenRect.Left = 0: screenRect.Top = 0: screenRect.Right = screenWidth: screenRect.Bottom = screenHeight
            GetValidAndAvailableRect = screenRect
        End If
    Else
        screenRect.Left = app.Left / PpX
        screenRect.Top = app.Top / PpX
        screenRect.Right = (app.Left + app.Width) / PpX
        screenRect.Bottom = app.Top + app.Height / PpX
        GetValidAndAvailableRect = screenRect
    End If
End Function

'sub de test
Sub Test_GetScreenAREA()
    Dim Rectangle As RECT, mess$

    Rectangle = GetValidAndAvailableRect() ' Obtenir le rectangle de la fentre excel

    'concat du message
    mess = "Rectangle Utilisé par la fenêtre Excel : " & vbCrLf & _
            "Left: " & Rectangle.Left & vbCrLf & _
            "Top: " & Rectangle.Top & vbCrLf & _
            "Right: " & Rectangle.Right & vbCrLf & _
            "Bottom: " & Rectangle.Bottom & vbCrLf & _
            "Largeur: " & (Rectangle.Right - Rectangle.Left) & vbCrLf & _
            "Hauteur: " & (Rectangle.Bottom - Rectangle.Top)

    ' Afficher les résultats
    MsgBox mess, vbInformation, "Rectangle de la fenêtre excel"
End Sub

' Déclarations API
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" ( _
    ByVal hdc As LongPtr, ByVal lprcClip As LongPtr, _
    ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Long

Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" ( _
    ByVal hMonitor As LongPtr, ByRef lpmi As monitorInfo) As Long

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
    ByVal nIndex As Long) As Long

Private Type rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type monitorInfo
    cbSize As Long
    rcMonitor As rect
    rcWork As rect
    dwFlags As Long
End Type

Private monitorRects As Collection

Private Function MonitorEnumProc(ByVal hMonitor As LongPtr, _
                                 ByVal hdc As LongPtr, _
                                 ByVal lprcClip As LongPtr, _
                                 ByVal dwData As LongPtr) As Long
    Dim monitorInfo As monitorInfo
    Dim rectVariant As Variant
    Dim tempRect As rect

    ' Initialiser la structure MONITORINFO
    monitorInfo.cbSize = Len(monitorInfo)
  
    ' Obtenir les informations du moniteur
    If GetMonitorInfo(hMonitor, monitorInfo) <> 0 Then
        ' Préparer un Variant pour stocker les champs du RECT
        tempRect = monitorInfo.rcWork
        rectVariant = Array(tempRect.Left, tempRect.Top, tempRect.Right, tempRect.Bottom)
      
        ' Ajouter le RECT à la collection
        monitorRects.Add rectVariant
    End If
  
    ' Continuer l'énumération
    MonitorEnumProc = 1
End Function

Public Function GetAllMonitorRects() As Collection
    ' Initialiser la collection
    Set monitorRects = New Collection
  
    ' Énumérer les écrans
    Call EnumDisplayMonitors(0, 0, AddressOf MonitorEnumProc, 0)
  
    ' Retourner la collection des rectangles
    Set GetAllMonitorRects = monitorRects
End Function

' Exemple d'utilisation
Sub TestMultiScreenRects()
    Dim allRects As Collection
    Dim rectVariant As Variant
    Dim rect As rect
    Dim i As Long
    Dim message As String
  
    ' Obtenir tous les rectangles des écrans
    Set allRects = GetAllMonitorRects()
  
    ' Parcourir chaque écran et construire le message
    message = "Rectangles des écrans disponibles :" & vbCrLf
    For i = 1 To allRects.Count
        rectVariant = allRects(i)
      
        ' Recréer un RECT à partir du Variant
        rect.Left = rectVariant(0)
        rect.Top = rectVariant(1)
        rect.Right = rectVariant(2)
        rect.Bottom = rectVariant(3)
      
        ' Construire le message
        message = message & "Écran " & i & ":" & vbCrLf & _
                  "  Left: " & rect.Left & vbCrLf & _
                  "  Top: " & rect.Top & vbCrLf & _
                  "  Right: " & rect.Right & vbCrLf & _
                  "  Bottom: " & rect.Bottom & vbCrLf & _
                  "  Largeur: " & (rect.Right - rect.Left) & vbCrLf & _
                  "  Hauteur: " & (rect.Bottom - rect.Top) & vbCrLf & vbCrLf
    Next i
  
    ' Afficher le résultat
    MsgBox message, vbInformation, "Rectangles des écrans"
End Sub