VBA错误1004不更新Field.CurrentPage

时间:2016-10-31 16:42:30

标签: excel vba excel-vba

我上周有这个工作。这将使用用户输入的值更新数据透视表搜索,然后根据该条目筛选数据透视表。这是在上周工作,当我更新文件(完全相同的布局)时,我开始收到错误1004.我没有更改任何VBA,所以很困惑为什么它不更新Field.CurrentPage值。任何帮助将不胜感激。

Public OldPull As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, it only updates when cell
'P4 is touched
If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim FValue As PivotItems
Dim NewPull As String

'Here you amend to suit your data
Set pt = Worksheets("Pull Code Search").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Pull Code")
Set FValue = Field.PivotItems

Err.Clear

If IsEmpty(Range("B4").Value) = True Then
   NewPull = "(All)"
Else
   NewPull = Worksheets("Pull Code Search").Range("B4").Value
End If

'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters

On Error GoTo ErrMsg

Field.CurrentPage = NewPull

   If NewPull = "(All)" And _
      OldPull <> NewPull Then
      ActiveSheet.PivotTables(1).PivotFields(1).ShowDetail = False
   End If

If OldPull <> NewPull Then
   pt.RefreshTable
End If

OldPull = NewPull

End With

'This is the error hangling section

ErrMsg:
   If Err.Number = 1004 Then
      msg = "Pull Code Was not Found" & Chr(13) _
      & "You have entered an invalid or partial Pull Code" & Chr(13) _
      & "Please try again" & Chr(13) _
      & "You searched for: " & NewPull
      MsgBox msg, , "Pull Code Not Found", Err.HelpFile, Err.HelpContext
      NewPull = "(All)"
   End If

   Resume Next


End Sub

0 个答案:

没有答案