Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal uCmd As Long) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpst As String, ByVal nMaxCount As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Dim HandleXLDESK As LongPtr
#Else
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal uCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpst As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Dim HandleXLDESK As Long
#End If
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Const GW_CHILD = 5
Const GW_hWndNEXT = 2
Private R As RECT
'------------------------------------------
'Reduce the Excel grid to its vertical half
'------------------------------------------
Sub ExcelGridToVerticalHalf()
#If VBA7 Then
Dim EXCEL7WindowHandle As LongPtr
#Else
Dim EXCEL7WindowHandle As Long
#End If
EXCEL7WindowHandle = GetEXCEL7WindowHandle
Call GetWindowRect(EXCEL7WindowHandle, R)
Call SetWindowPos(GetEXCEL7WindowHandle, 0, 0, 0, (R.right - R.left) / 2, R.bottom - R.top, 0&)
End Sub
'-------------------------------------------
'Restore the Excel grid to its original size
'-------------------------------------------
Sub ExcelGridRestore()
If HandleXLDESK = 0 Then Exit Sub
Call GetWindowRect(HandleXLDESK, R)
Call SetWindowPos(GetEXCEL7WindowHandle, 0, 0, 0, R.right - R.left, R.bottom - R.top, 0&)
End Sub
'-------------------------------
'Find the "EXCEL7" Window Handle
'Sur le modèle de code de @patricktoulon
'-------------------------------
#If VBA7 Then
Private Function GetEXCEL7WindowHandle(Optional hwnd As LongPtr = 0) As LongPtr
Dim hWndChild As LongPtr
Static hWndResult As LongPtr
#Else
Private Function GetEXCEL7WindowHandle(Optional hwnd As Long = 0) As Long
Dim hWndChild As Long
Static hWndResult As Long
#End If
'Initial call
If hwnd = 0 Then
'Parent Handle
hwnd = Application.hwnd
'Recursive call
Else
'Result found
If Not hWndResult = 0 Then Exit Function
End If
hWndChild = GetWindow(hwnd, GW_CHILD)
Do While Not hWndChild = 0
If GetWindowClassName(hwnd) = "XLDESK" Then HandleXLDESK = hwnd
If GetWindowClassName(hwnd) = "EXCEL7" Then
hWndResult = hwnd
Exit Do
End If
'Recursive call
Call GetEXCEL7WindowHandle(hWndChild)
hWndChild = GetWindow(hWndChild, GW_hWndNEXT)
Loop
'Return value
GetEXCEL7WindowHandle = hWndResult
End Function
'------------------------
'Class name of the Window
'------------------------
#If VBA7 Then
Private Function GetWindowClassName(hwnd As LongPtr) As String
#Else
Private Function GetWindowClassName(hwnd As Long) As String
#End If
Dim Buffer As String
Dim Count As Integer
Const MAXLEN = 255
Buffer = String$(MAXLEN - 1, 0)
Count = GetClassName(hwnd, Buffer, MAXLEN)
'Return value
If Count > 0 Then
GetWindowClassName = left$(Buffer, Count)
End If
End Function
