Gruppe
API
Problem
In Zelle B2 soll der Fenstername der in Zelle B1 genannten Anwendung genannt werden.
StandardModule: Modul1
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public WndText As String
Public Function GetActiveWindowTitle() As String
Dim nHWnd As Long
Dim sTitle As String
Dim nResult As Long
nHWnd = GetForegroundWindow()
sTitle = Space$(255)
nResult = GetWindowText(nHWnd, sTitle, Len(sTitle))
GetActiveWindowTitle = Left$(sTitle, nResult)
End Function
Sub Aufruf()
On Error GoTo ERRORHANDLER
Shell Range("B1").Value, vbNormalFocus
Range("B2").Value = GetActiveWindowTitle
Exit Sub
ERRORHANDLER:
MsgBox "Das Programm wurde nicht gefunden!"
Range("B2").ClearContents
End Sub