我可以在显示“插入函数/函数参数”对话框时禁用VBA UDF计算吗?



我有一个Excel VBA UDF,可以执行一些昂贵的计算。 目前,当用户单击"插入函数"对话框(编辑栏旁边的"fx"按钮)时,Excel 会尝试运行该函数,这会导致我的代码出现问题。

有没有办法将函数设置为当用户打开"插入函数"对话框(或"函数参数"对话框,这是已提供函数名称时显示的内容)时不计算? 我希望该函数仅在用户在单元格中输入公式或刷新工作表时运行。

尝试将以下代码添加到函数的开头:

If (Not Application.CommandBars("Standard").Controls(1).Enabled) Then Exit Function

如果使用函数向导,它将退出您的 UDF

有一种

情况是,Charles Williams 提供的"CommandBars"解决方案失败,错误地指示函数向导处于活动状态,而实际上并非如此。

当您在 Excel 中打开逗号分隔的文本文件时,就会发生这种情况,在这种情况下,将重新计算所有打开的 Excel 工作簿,即使 Excel 计算设置为手动也是如此。如果您打开了使用计算缓慢的 VBA UDF 的工作簿,如果认为向导处于活动状态,则使用 CommandBars 测试提前退出,这将非常具有破坏性。

Charles进一步建议,Windows API可以用作替代方法。我无法在其他地方找到这样的代码,所以这是我尝试实现查尔斯的建议。

仅在英语 64 位 Excel 365 上测试。

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As LongPtr, ByRef lpdwProcessId As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Const GW_HWNDNEXT = 2

Function FunctionWizardActive() As Boolean
    Dim ExcelPID As Long
    Dim lhWndP As LongPtr
    Dim WindowTitle As String
    Dim WindowPID As Long
    Const FunctionWizardCaption = "Function Arguments" 'This won't work for non English-language Excel
    
    If TypeName(Application.Caller) = "Range" Then
        'The "CommandBars test" below is usually sufficient to determine that the Function Wizard is active,
        'but can sometimes give a false positive. Example: When a csv file is opened (via File Open) then all
        'active workbooks are calculated (even if calculation is set to manual!) with
        'Application.CommandBars("Standard").Controls(1).Enabled being False
        'So apply a further test using Windows API to loop over all windows checking for a window with title "Function  Arguments", checking also the process id.
        If Not Application.CommandBars("Standard").Controls(1).Enabled Then
            ExcelPID = GetCurrentProcessId()
            lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
            Do While lhWndP <> 0
                WindowTitle = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
                GetWindowText lhWndP, WindowTitle, Len(WindowTitle)
                WindowTitle = Left$(WindowTitle, Len(WindowTitle) - 1)
                If WindowTitle = FunctionWizardCaption Then
                    GetWindowThreadProcessId lhWndP, WindowPID
                    If WindowPID = ExcelPID Then
                        FunctionWizardActive = True
                        Exit Function
                    End If
                End If
                lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
            Loop
        End If
    End If
End Function

使用该函数可用,您可以使用以下代码修改慢速 VBA UDF:

If FunctionWizardActive() Then Exit Function

最新更新