AW: Windows.Arrange
14.02.2021 18:53:45
Nepumuk
Hallo Jerry,
teste mal:
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" ( _
ByVal hdc As LongPtr, _
ByVal nIndex As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const SM_CXSCREEN As Long = 0&
Private Const SM_CYSCREEN As Long = 1&
Private Const LOGPIXELS_X As Long = 88&
Private Const LOGPIXELS_Y As Long = 90&
Private Const GC_CLASSNAMETASKBAR As String = "Shell_TrayWnd"
Public Sub ArrangeWindows()
Dim sngWidth As Single, sngHeight As Single
Dim lngptrHwnd As LongPtr
Dim udtRectangle As RECT
sngWidth = GetResolution(LOGPIXELS_X)
sngHeight = GetResolution(LOGPIXELS_Y)
lngptrHwnd = FindWindowA(GC_CLASSNAMETASKBAR, vbNullString)
Call GetWindowRect(lngptrHwnd, udtRectangle)
'Linkes Fenster
With Workbooks("Mappe1.xlsm").Windows(1) 'Anpassen !!!
.WindowState = xlNormal
.Top = 0
.Left = 0
.Width = GetSystemMetrics(SM_CXSCREEN) * sngWidth / 2
.Height = (GetSystemMetrics(SM_CYSCREEN) - _
(udtRectangle.Bottom - udtRectangle.Top)) * sngHeight
End With
'Rechtes Fenster
With Workbooks("Mappe2.xlsm").Windows(1) 'Anpassen !!!
.WindowState = xlNormal
.Top = 0
.Left = GetSystemMetrics(SM_CXSCREEN) * sngWidth / 2
.Width = GetSystemMetrics(SM_CXSCREEN) * sngWidth / 2
.Height = (GetSystemMetrics(SM_CYSCREEN) - _
(udtRectangle.Bottom - udtRectangle.Top)) * sngHeight
End With
End Sub
Private Function GetResolution(ByVal pvlngLogPixel As Long) As Single
Dim lngptrhWndDesk As LongPtr, lngptrhDCDesk As LongPtr
Dim lnglogPixel As Long
lngptrhWndDesk = GetDesktopWindow()
lngptrhDCDesk = GetDC(lngptrhWndDesk)
lnglogPixel = GetDeviceCaps(lngptrhDCDesk, pvlngLogPixel)
Call ReleaseDC(lngptrhWndDesk, lngptrhDCDesk)
GetResolution = 72 / lnglogPixel
End Function
Gruß
Nepumuk