VBA 读取活动程序的代码

Question

我希望这个宏可以不断记录当前活动程序的名称。我有一个用户表单，它运行一个计时器用户一个宏，它每秒回忆一次。我希望它在同一个宏中记录活动 window 的名称，并且（如果与姓氏不同）将其附加到描述性字符串上。

我最初使用 "Active 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

整个宏：

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

要获取活动 application/window 的名称，您需要使用 API 调用。

This Question office 网站上的应该对你有帮助。

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 sub 应该将活动 window 的标题打印到调试控制台。

VBA 读取活动程序的代码

VBA Code to Read the Active Program

excel

vba