如何解决ListObject.Querytable 的 QueryTable_AfterRefresh 在 Excel 2016 中不起作用
我正在提取一组 csv 文件作为 poweryQuery 表,我在 Excel 2016 Pro 工作簿中按特定顺序运行这些表。我在 QueryTable AddOutcomeColumn
事件中调用外部过程 After_Refresh
以向某些 ListObject QueryTable 添加额外的列。两天前它可以工作,但现在无法工作。代码保持不变。
类 clsQR 码:
Option Explicit
Private WithEvents QTable As Excel.QueryTable
Private pMsg As String
Private colCollection As New Collection
Public Property Let Message(msg As String)
pMsg = msg
End Property
Public Property Get Message() As String
Message = pMsg
End Property
Public Sub Init(ByRef QT As Excel.QueryTable)
Set QTable = QT
With QTable
.Refresh False
End With
colCollection.Add Item:=QTable,Key:=pMsg
End Sub
Private Sub QTable_BeforeRefresh(Cancel As Boolean)
Application.StatusBar = "Refreshing Query... " & pMsg
End Sub
Private Sub QTable_AfterRefresh(ByVal Success As Boolean)
Application.StatusBar = "Refreshed Query... " & pMsg
If QTable.ListObject.Name = "jkl" Then
AddOutcomeColumn QTable
End If
End Sub
模块主代码:
Option Explicit
Dim clsQ As clsQR
Dim QT As QueryTable
Sub GetCSVFilenames()
Dim oFD As FileDialog
Dim oFile As Object,oFiles As Object,oFolder As Object
Dim sPath As String
On Error GoTo ErrorHandler
' disableupdating "GetCSVFilenames"
Set clsQ = New clsQR
Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
.Title = "Select CSV folder"
.InitialFileName = Environ("USERPROFILE") & "\Desktop"
If oFD.Show = -1 Then
With ThisWorkbook.Sheets("AAA")
.Cells(4,"F") = oFD.SelectedItems(1)
Set QT = .ListObjects("abc").QueryTable
clsQ.Message = "abc"
clsQ.Init QT:=QT
End With
With ThisWorkbook.Sheets("BBB")
Set QT = .ListObjects("def").QueryTable
clsQ.Message = "def"
clsQ.Init QT:=QT
Set QT = .ListObjects("ghi").QueryTable
clsQ.Message = "ghi"
clsQ.Init QT:=QT
End With
With ThisWorkbook.Sheets("CCC")
Set QT = .ListObjects("jkl").QueryTable
clsQ.Message = "jkl"
clsQ.Init QT:=QT
If ThisWorkbook.Sheets("CCC").Visible = xlSheetHidden Then ThisWorkbook.Sheets("CCC").Visible = True
End With
With ThisWorkbook.Sheets("DDD")
Set QT = .ListObjects("mno").QueryTable
clsQ.Message = "mno"
clsQ.Init QT:=QT
If ThisWorkbook.Sheets("DDD").Visible = xlSheetHidden Then ThisWorkbook.Sheets("DDD").Visible = True
End With
With ThisWorkbook.Sheets("EEE")
Set QT = .ListObjects("pqr").QueryTable
clsQ.Message = "pqr"
clsQ.Init QT:=QT
If ThisWorkbook.Sheets("EEE").Visible = xlSheetHidden Then ThisWorkbook.Sheets("EEE").Visible = True
End With
With ThisWorkbook.Sheets("FFF")
Set QT = .ListObjects("stu").QueryTable
clsQ.Message = "stu"
clsQ.Init QT:=QT
If ThisWorkbook.Sheets("FFF").Visible = xlSheetHidden Then ThisWorkbook.Sheets("FFF").Visible = True
End With
With ThisWorkbook.Sheets("GGG")
Set QT = .ListObjects("vwx").QueryTable
clsQ.Message = "vwx"
clsQ.Init QT:=QT
If ThisWorkbook.Sheets("GGG").Visible = xlSheetHidden Then ThisWorkbook.Sheets("GGG").Visible = True
End With
End If
End With
Application.StatusBar = ""
ExitSub:
' Enableupdating "GetCSVFilenames"
Exit Sub
ErrorHandler:
MsgBox "Error#: " & Err.Number & vbCrLf & "Description: " & Err.Description,vbCritical + vbOKOnly,"An Error occurred!"
Err.Clear
On Error GoTo 0
Resume ExitSub
End Sub
这是因为这些是 Listobject Querytables
而不是纯 Excel 查询表,事件可能不再存在吗?或者在 Excel 2016 中有什么变化?我无法在刷新一个或多个查询后运行 AddOutcomeColumn
过程(例如,我刚刚在类的 if 条件中添加了 1 个查询)。
解决方法
我通过在启用/禁用 QTable_AfterRefresh
的 Main procedure
代码中调用这些自定义过程行来禁用 Application events
事件。
DisableUpdating "GetCSVFilenames"
和
EnableUpdating "GetCSVFilenames"
在我注释掉代码后,事件开始正常触发!
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。