MS Project VBA - 当过滤器 returns 什么都没有时如何避免错误

Question

我的代码对项目应用了一个过滤器（只显示下周特定资源的活动），我需要捕获过滤器 returns 什么都没有的实例。

我找到了这个 article which leads to this MS Entry。由此我想出了测试：

If ActiveSelection.Tasks Is Nothing Then GoTo NextResource

退出当前资源循环并转到下一个，但是，这不起作用。仅当我尝试使用 ActiveSelection

时才会生成错误 (424)

上下文代码片段：

For Each Resource In Proj.Resources
    If Not (Resource Is Nothing) Then
    If Resource.Work > 0 Then
     'setup and apply filter for each resource
     FilterEdit name:="filter4people", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Start", Test:="is less than or equal to", Value:=finish, ShowInMenu:=True, ShowSummaryTasks:=True
     FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="% Complete", Test:="is less than", Value:="100%", Operation:="And", ShowSummaryTasks:=True
     FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="Resource names", Test:="contains", Value:=Resource.name, Operation:="And", ShowSummaryTasks:=True
         
     FilterApply "filter4people" ' apply the filter
        If Not (Err.Number = 91 Or Err.Number = 0) Then            ' saw an error applying filter
             Err.Clear                   ' clear out the error
             GoTo NextResource           ' jump to the next resource
         End If

    Application.SelectSheet 'need to select the sheet so that ActiveSelection works properly
    
    'CStr(ActiveSelection.Tasks.Count)
    If ActiveSelection.Tasks Is Nothing Then GoTo NextResource

Answer 1

您的问题是，如果没有任务满足所应用的过滤器的条件，则 ActiveSelection 对象无法解析 .Tasks 属性。我不喜欢将 GoTos 用于 VBA 中不是错误处理程序的任何内容，因此我建议创建一个单独的函数来检查过滤器中是否有任何任务：

Public Function CurrentFilterHasTasks() As Boolean

   Dim result As Boolean
   On Error GoTo ErrHandler

   Application.SelectAll 'select everything in the current filter

   'Application.ActiveSelection.Tasks will fail if there are only blank rows in the active selection
   If Application.ActiveSelection.Tasks.Count > 0 Then
        result = True
   End If

   CurrentFilterHasTasks = result

   'call exit function here so the code below the error handler does not run
   Exit Function

ErrHandler:
   result = False
   CurrentFilterHasTasks = result
    
End Function

现在您可以在代码中调用此函数了：

For Each Resource In Proj.Resources
    If Not (Resource Is Nothing) Then
        If Resource.Work > 0 Then
         'setup and apply filter for each resource
         FilterEdit Name:="filter4people", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Start", test:="is less than or equal to", Value:=Finish, ShowInMenu:=True, ShowSummaryTasks:=True
         FilterEdit Name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="% Complete", test:="is less than", Value:="100%", Operation:="And", ShowSummaryTasks:=True
         FilterEdit Name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="Resource names", test:="contains", Value:=Resource.Name, Operation:="And", ShowSummaryTasks:=True
             
         FilterApply "filter4people" ' apply the filter
         
         If Not (Err.Number = 91 Or Err.Number = 0) Then ' saw an error applying filter
             Err.Clear                   ' clear out the error
             GoTo NextResource           ' jump to the next resource
         End If
        
        ''''' Calling the new function ''''''
        If CurrentFilterHasTasks Then
            'whatever you want to do with the filtered tasks here
        End If

此外，我可能会卸载您的代码以创建过滤器并将其应用到它自己的方法中，这样您就可以检查其中的任何错误，而不是检查您的主要方法。

MS Project VBA - 当过滤器 returns 什么都没有时如何避免错误

MS Project VBA - how to avoid errors when a filter returns nothing

vba

ms-project