VBA代码读取活动的程序

我的希望是让这个macros不断logging当前活动程序的任何程序的名称。 我有一个用户窗体，运行一个计时器用户一个macros，每秒都会自我回忆。 我希望它logging在同一个macros中的活动窗口的名称（如果与姓氏不同），将其附加到描述性string。

我原来使用“活动window.caption”只知道它不适用于其他程序（如chrome，word或Outlook），但下面是我的代码块。

If ActiveApp <> ActiveWindow.Caption Then 'look at active program for name ActiveApp = ActiveWindow.Caption 'if the last name is not the same as the current aapp2 = ThisWorkbook.Sheets("bts").Range("b13").Value & "|" & ActiveApp & ": " & Format(dteElapsed, "hh:mm:ss") 'updates the descriptive string ThisWorkbook.Sheets("bts").Range("b13").Value = aapp2 End If 

整体macros观：

 Sub timeloop() If ThisWorkbook.Sheets("BTS").Range("b7").Value = "" Then 'the location on theworksheet that time is stored ThisWorkbook.Sheets("BTS").Range("b7").Value = Time ' ThisWorkbook.Sheets("BTS").Range("b12").Value = Date End If dteStart = ThisWorkbook.Sheets("BTS").Range("b7").Value dteFinish = Time DoEvents dteElapsed = dteFinish - dteStart If Not booldead = True Then 'See if form has died TimeRun.Label1 = Format(dteElapsed, "hh:mm:ss") If ActiveApp <> ActiveWindow.Caption Then 'look at active program for name ActiveApp = ActiveWindow.Caption 'if the last name is not the same as the current aapp2 = ThisWorkbook.Sheets("bts").Range("b13").Value & "|" & ActiveApp & ": " & Format(dteElapsed, "hh:mm:ss") 'updates the descriptive string ThisWorkbook.Sheets("bts").Range("b13").Value = aapp2 End If Else Exit Sub End If Alerttime = Now + TimeValue("00:00:01") Application.OnTime Alerttime, "TimeLoop" End Sub 

Answer 1

要获取活动应用程序/窗口的名称，您需要使用API​​调用。

办公室网站上的这个问题应该可以帮到你。

 Public Declare Function GetForegroundWindow Lib "user32" _ Alias "GetForegroundWindow" () As Long Public Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" (ByVal hwnd As Long, _ ByVal lpString As String, ByVal cch As Long) As Long Sub AAA() Dim WinText As String Dim HWnd As Long Dim L As Long HWnd = GetForegroundWindow() WinText = String(255, vbNullChar) L = GetWindowText(HWnd, WinText, 255) WinText = Left(WinText, InStr(1, WinText, vbNullChar) - 1) Debug.Print L, WinText End Sub 

运行AAA子应该打印活动窗口的标题到debugging控制台。