Excel VBA错误 - 当代码与其他启用宏的工作簿一起运行时,工作簿不响应

时间:2017-07-06 19:58:43

标签: excel vba excel-vba

背景

我陷入两难境地。我工作了大约一个月的工作簿。我有许多命名范围,三个查询和几个表。其中一个表(TABLE_Syteline_JobBills)是从另一个表构建的,该表是来自数据库的查询。我刷新这个表(TABLE_Syteline_SingleLevel),每次3次,每次都将数据附加到JobBills表。

问题

只有在没有其他启用宏的工作簿打开时,代码才有效。如果启用了启用宏的工作簿,则会收到错误

  

运行时错误 - 自动化错误 - 调用的对象已与其客户端断开连接。

它出现在这一行:

.ListRows.Add(AlwaysInsert = True).Range = Row.Value

在打开启用宏的工作簿之前,代码可以正常运行。常规工作簿不会导致代码错误。当这是唯一启用宏的工作簿时,将不会出现错误。根据您打开的启用宏的工作簿,错误可能不会发生,直到第三次通过嵌套for循环。

守则

这是......导致问题的子

'Option Explicit

Sub UpdatingTableJobBills()
'--------------------------------------------------------------------------------
'Programmer's Notes
'--------------------------------------------------------------------------------
'Copies three sets of data one at a time to one big table refreshing each time
'--------------------------------------
'Variable Declarations
'--------------------------------------
Dim JobNumber As String 'Variable Job Number
Dim RowCount As Integer 'Number of rows in table
Dim BOMSuffixes As Variant
Dim BOMSuffix As Variant
Dim Row As Range 'Used to loop through the different rows in the SingleLevel table we are going to insert into the JobBill table

'--------------------------------------
'Variable Definitions
'--------------------------------------
BOMSuffixes = Array("-conv", "-devices", "-electrical")
JobNumber = ThisWorkbook.Worksheets("Cost Analysis").Range("JobNumber").Value 'job number - read from named cell

'--------------------------------------
'Delete any old data
'--------------------------------------
WipeOutBillData '---this function simply deletes 3 table databodyranges if they aren't empty already

'--------------------------------------
'Loop through each query and copy the query results to the JobBills table
'--------------------------------------
For Each BOMSuffix In BOMSuffixes
    ThisWorkbook.Worksheets("BOM Query").Range("PartNumber").Value = JobNumber & BOMSuffix 'Changes part number to prepare for refresh
    ThisWorkbook.Connections("Syteline_Query_BOM").Refresh 'Refreshes specific connection to syteline
    With ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills")
        If WorksheetFunction.CountA(ThisWorkbook.Worksheets("BOM Query").Range("TABLE_Syteline_SingleLevel")) <> 0 Then
            For Each Row In ThisWorkbook.Worksheets("BOM Query").ListObjects("TABLE_Syteline_SingleLevel").DataBodyRange.Rows
                .ListRows.Add(AlwaysInsert:=True).Range = Row.Value  '******** The row behind the trouble *********
            Next Row
        End If
    End With
Next BOMSuffix

Set Row = Nothing

With ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills")
    If IsEmpty(ThisWorkbook.Worksheets("Job Data").Range("TABLE_Syteline_JobBills[Child]")) Then
        Call MsgBox("No data has been returned for job number: " & JobNumber, vbSystemModal, "No Data Returned")
        Exit Sub
    End If
    .DataBodyRange.Cells(2, .ListColumns("Extended Cost").index).Value = "=[Qty]*[Cost]" 'Redefines the value of column "Extended Cost"
End With


'--------------------------------------
'Sorts the table JobBills by descending Ext Cost
'--------------------------------------
ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills"). _
    Sort.SortFields.Clear
ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills"). _
    Sort.SortFields.Add Key:=Range( _
"TABLE_Syteline_JobBills[[#All],[Extended Cost]]"), SortOn:=xlSortOnValues, _
    Order:=xlDescending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets("Job Data").ListObjects( _
    "TABLE_Syteline_JobBills").Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'--------------------------------------
'Deletes rows with an Extended Cost of Zero
'--------------------------------------

Dim Description As String
Dim RowMover As Integer
Dim ExtRowCounter As Integer

ExtRowCounter = 2

Do While Not IsEmpty(ThisWorkbook.Worksheets("Job Data").Cells(ExtRowCounter, ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills").ListColumns("Extended Cost").index))
    If ThisWorkbook.Worksheets("Job Data").Cells(ExtRowCounter, ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills").ListColumns("Extended Cost").index).Value = 0 Then
        ThisWorkbook.Worksheets("Job Data").Cells(ExtRowCounter, ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills").ListColumns("Extended Cost").index).EntireRow.Delete
        ExtRowCounter = ExtRowCounter - 1
    End If
    ExtRowCounter = ExtRowCounter + 1
Loop
End Sub

如果有人可以提供任何可能的解释或解决方案,我会得到这个错误,我将不胜感激。我只是无法理解为什么代码不能与另一个启用宏的工作簿打开。我确定我特意引用了“thisworkbook ......”。也许我在excel中选择了一个设置,导致启用宏的工作簿相互作用。

无论如何 - 提前感谢您的任何建议!

1 个答案:

答案 0 :(得分:0)

这部分对我来说似乎很可疑:

With ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills")
        If WorksheetFunction.CountA(ThisWorkbook.Worksheets("BOM Query").Range("TABLE_Syteline_SingleLevel")) <> 0 Then
            For Each Row In ThisWorkbook.Worksheets("BOM Query").ListObjects("TABLE_Syteline_SingleLevel").DataBodyRange.Rows
                .ListRows.Add(AlwaysInsert:=True).Range = Row.Value  '******** The row behind the trouble *********
            Next Row
        End If
    End With

Reduntant使用块,尝试使用显式对象地址?同一行,您访问Range对象并为其分配Range.Value。

尝试:

 ThisWorkbook.Worksheets("Job Data").ListObjects("TABLE_Syteline_JobBills") _
.ListRows.Add(AlwaysInsert:=True).Range.Value = Row.Value

另一个想法是尝试使用Workbooks(“wbName”)而不是ThisWorkbook来确保处理正确的工作簿。

更新: 尝试发表评论Set Row = Nothing