添加自动查询后,我可以修复运行时错误9吗



我对VBA编码还比较陌生,遇到了一个问题,我自己无法解决这个问题。每天早上,我手动刷新与同一工作簿中的两个不同选项卡关联的两个文件的查询。生成的表然后由我创建的宏"来操作;取消上市";表,然后进一步格式化它们。因此,我认为将数据查询添加到我现有的宏中是一个好主意,最初遇到运行时错误1004,我通过重新记录整个宏克服了这个错误,确保我关闭了";启用背景刷新;但现在我正受到运行时错误9的困扰。这是我对整个宏的代码:

Sub AM_1()
'
' AM_1 Macro
' Newest corrections 03.19.2021
'
'
With ActiveWorkbook.Connections("Query - mtbt").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("SELECT * FROM [mtbt]")
.CommandType = xlCmdSql
.Connection = _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=mtbt;Extended Properties="""""
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Query - mtbt")
.Name = "Query - mtbt"
.Description = "Connection to the 'mtbt' query in the workbook."
End With
With ActiveWorkbook.Connections("Query - mtbm").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("SELECT * FROM [mtbm]")
.CommandType = xlCmdSql
.Connection = _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=mtbm;Extended Properties="""""
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Query - mtbm")
.Name = "Query - mtbm"
.Description = "Connection to the 'mtbm' query in the workbook."
End With
ActiveWorkbook.Connections("Query - mtbm").Refresh
ActiveWorkbook.Connections("Query - mtbt").Refresh
ActiveSheet.ListObjects("mtbt").Unlist
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1:C51").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ActiveWorkbook.Worksheets("mtbm").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("mtbm").Sort.SortFields.Add2 Key:=Range("C1:C300") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("mtbm").Sort
.SetRange Range("A1:C300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B1:B300").Select
Selection.NumberFormat = "#,##0.00"
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").Select
Selection.ColumnWidth = 71
Range("A1:C300").Select
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 70
ActiveWindow.Zoom = 55
Columns("B:B").Select
Columns("B:B").EntireColumn.AutoFit
Sheets("mtbt").Select
Range("B1:B51").Select
Selection.NumberFormat = "#,##0.00"
Range("A1:C51").Select
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Sheets("mtbm").Select
End Sub

紧接在";刷新";动作下一行是";未列出";";mtbt";在选项卡中创建的具有相同名称的表,但这就是它给我错误的地方。

任何帮助都将不胜感激。。。谢谢

假设代码在运行时会创建一个新的列表对象,那么您可以尝试使用ActiveSheet.ListObjects.Count来引用新列表对象。

我在下面的代码中添加了这一点,并删除了所有不需要的Select/Selection内容。

您可能还想用对"mtbt"工作表的显式引用来替换ActiveSheet through——您甚至可以在引用工作表的代码中添加一个变量,并在整个过程中使用它。

Sub AM_1()
'
' AM_1 Macro
' Newest corrections 03.19.2021
'
'
With ActiveWorkbook.Connections("Query - mtbt").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("SELECT * FROM [mtbt]")
.CommandType = xlCmdSql
.Connection = _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=mtbt;Extended Properties="""""
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Query - mtbt")
.Name = "Query - mtbt"
.Description = "Connection to the 'mtbt' query in the workbook."
End With
With ActiveWorkbook.Connections("Query - mtbm").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("SELECT * FROM [mtbm]")
.CommandType = xlCmdSql
.Connection = _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=mtbm;Extended Properties="""""
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Query - mtbm")
.Name = "Query - mtbm"
.Description = "Connection to the 'mtbm' query in the workbook."
End With
ActiveWorkbook.Connections("Query - mtbm").Refresh

ActiveSheet.ListObjects(ActiveSheet.ListObjects.Count).Unlist
Rows("1:1").Delete Shift:=xlUp
With Range("A1:C51")
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
With .Font
.Color = -16776961
.TintAndShade = 0
End With
End With
ActiveWorkbook.Worksheets("mtbm").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("mtbm").Sort.SortFields.Add2 Key:=Range("C1:C300") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("mtbm").Sort
.SetRange Range("A1:C300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B1:B300").NumberFormat = "#,##0.00"
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 71
With Range("A1:C300").Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

Columns("B:B").EntireColumn.AutoFit
Sheets("mtbt").Range("B1:B51").NumberFormat = "#,##0.00"
With Range("A1:C51").Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End Sub

相关内容

最新更新