Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nshowcmd As Long _
) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" ( _
ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Public Declare Function MoveWindow Lib "user32" ( _
ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Sub byShell()
Dim i As Integer
Dim strLink As String
Dim strWndName As String
For i = 1 To 4
strLink = Cells(i, 1).Value
strWndName = WndName(strLink)
Auto_Open strLink, strWndName, i
Next i
End Sub
Private Sub Auto_Open(imgPath As String, imgWnd As String, cnt As Integer)
Dim cmdPath As String
Dim hWnd As Long
Dim arrQ() As Long
arrQ = QuarterIt(cnt)
hWnd = ShellExecute(0, "", imgPath, "", "", 0)
Sleep 100
hWnd = FindWindow(vbEmpty, imgWnd)
Sleep 100
Call MoveWindow(hWnd, arrQ(0), arrQ(1), arrQ(2), arrQ(3), 1)
Sleep 100
End Sub
Function QuarterIt(nQ As Integer) As Variant
Dim R As RECT
Dim arrPos(0 To 3) As Long
If GetWindowRect(GetDesktopWindow, R) = 0 Then Exit Function
Select Case nQ
Case 1
arrPos(0) = 0
arrPos(1) = 0
arrPos(2) = R.Right / 2 - 2
arrPos(3) = R.Bottom / 2 - 2
Case 2
arrPos(0) = 0
arrPos(1) = R.Bottom / 2 + 1
arrPos(2) = R.Right / 2 - 2
arrPos(3) = R.Bottom / 2 - 2
Case 3
arrPos(0) = R.Right / 2 + 1
arrPos(1) = 0
arrPos(2) = R.Right / 2 - 2
arrPos(3) = R.Bottom / 2 - 2
Case 4
arrPos(0) = R.Right / 2 + 1
arrPos(1) = R.Bottom / 2 + 1
arrPos(2) = R.Right / 2 - 2
arrPos(3) = R.Bottom / 2 - 2
End Select
QuarterIt = arrPos
End Function
Private Function WndName(LinkPath) As String
Dim strNm As String
strNm = Split(LinkPath, "\")(UBound(Split(LinkPath, "\")))
strNm = strNm & " - Windows-Fotoanzeige"
WndName = strNm
End Function