Excel 未激活时聚焦到 MgsBox

Question

我已经查看了this or this one等相关问题，但那里的解决方案似乎并没有解决我的问题。

我是运行我电脑上的一个 VBA 脚本。该脚本需要几分钟才能执行，在等待期间我正在检查计算机中的其他内容。为了在脚本完成运行后引起我的注意，我在脚本末尾添加了一个 MsgBox。但是，因为脚本完成时 Excel 不是 active/selected，所以我看不到它 - 只有当我 reactivate/select Excel.

如何在 Excel 未激活时使 MsgBox 聚焦？ 我已经尝试了以下调整，但它们不起作用：

ThisWorkbook.Activate:

...
ThisWorkbook.Activate
MsgBox "..."
...

AppActivate()（此命令引发错误）：

...
AppActivate("Microsoft excel")
MsgBox "..."
...

Answer 1

尝试：

Application.WindowState = xlMaximized

Answer 2

免责声明：这不是我的代码，我不知道作者是谁。我的数据库中有这段代码。

将您的代码放入 Sub Sample()。我已经展示了您可以插入代码的位置。一旦代码为运行，Excel 将闪烁 5 次。您可以通过更改 Private Const NumberOfFlashes = 5

来更改此数字

将其粘贴到模块中。

Option Explicit

Private Type FLASHWINFO
    cbSize As Long
    Hwnd As Long
    dwFlags As Long
    uCount As Long
    dwTimeout As Long
End Type

Private Const FLASHW_STOP As Long = 0
Private Const FLASHW_CAPTION As Long = &H1
Private Const FLASHW_TRAY As Long = &H2
Private Const FLASHW_ALL As Long = (FLASHW_CAPTION Or FLASHW_TRAY)
Private Const FLASHW_TIMER As Long = &H4
Private Const FLASHW_TIMERNOFG As Long = &HC
Private FLASHW_FLAGS As Long

Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long

Private Declare Function FlashWindowEx Lib "user32" _
(FWInfo As FLASHWINFO) As Boolean

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const NumberOfFlashes = 5

Private Function APIFunctionPresent(ByVal FunctionName _
   As String, ByVal DllName As String) As Boolean

    Dim lHandle As Long
    Dim lAddr  As Long

    lHandle = LoadLibrary(DllName)
    If lHandle <> 0 Then
        lAddr = GetProcAddress(lHandle, FunctionName)
        FreeLibrary lHandle
    End If

    APIFunctionPresent = (lAddr <> 0)

End Function

Sub Sample()
    '
    ' Put your code here. Once that code finishes, Excel will FLASH
    '

    Dim udtFWInfo As FLASHWINFO

    If Not APIFunctionPresent("FlashWindowEx", "user32") Then Exit Sub

    With udtFWInfo
       .cbSize = Len(udtFWInfo)
       .Hwnd = Application.Hwnd
       .dwFlags = FLASHW_FLAGS Or FLASHW_TRAY
       .uCount = NumberOfFlashes
       .dwTimeout = 0
    End With

    Call FlashWindowEx(udtFWInfo)

    MsgBox "Done"
End Sub

Answer 3

最简单的方法可能是创建一个用户表单，然后在它初始化时将焦点设置到此。

用户窗体中显示为模式的代码：

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
    As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1

Private Sub UserForm_Initialize()
    Dim hwnd As Long: hwnd = FindWindow(vbNullString, Me.Caption)
    If hwnd > 0 Then SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS   ' Set Modal
End Sub

Answer 4

程序结束时播放声音怎么样？将此声明放在标准代码模块的顶部，高于那里现有的任何过程。

Public Declare Function Beep Lib "kernel32" _
              (ByVal dwFreq As Long, _
               ByVal dwDuration As Long) As Long

如果将此过程放在同一个模块中，则可能不需要 public。根据您的喜好调整音高和持续时间。

Sub EndSound()
    Beep 500, 1000
End Sub

然后将过程调用放在程序的末尾。

Call EndSound

我想您可能会使用更精致的声音 - 我可以推荐贝多芬第五小节中的几个小节吗？修改 EndSound 过程。 Chip Pearson 有更多关于这个想法的内容。

Excel 未激活时聚焦到 MgsBox

Focus to MgsBox when Excel is not active

excel

vba

focus

msgbox