Таблица refre sh vba excel Вызов процедуры из другой процедуры Код ошибки 1004

Question

У меня есть процедура вызова для очистки содержимого таблиц на нескольких листах. Эта процедура вызывается только со 2-го листа рабочей книги. Когда я вызываю это, я получаю сообщение об ошибке 1004 «Ошибка приложения или объекта».

Ниже приведена база родительского кода, вызывающая процедуру:

Sub ValidateData_BDV1()
On Error Resume Next
Err.Clear

'''''Define Variables'''''''''
Dim mySheet As Worksheet
Dim mySheetName As String
Dim bdvName As Variant
Dim sqlQuery As String
Dim connectStr As String
Dim wsMatch As Worksheet

Dim myWorkbook As Workbook: Set myWorkbook = ThisWorkbook

'''''''''Set Variables''''''''
cancelEvent = False
Set mySheet = ActiveSheet                   'Sets mySheet variable as current active sheet
mySheetName = mySheet.Name

driverName = mySheet.Range("B1").Value2     'Get the value of the TDV driver
' MsgBox driver
dataSourceName = mySheet.Range("B3").Value2 'Get the data source name for the published TDV database
' MsgBox dataSourceName
schemaName = mySheet.Range("B5").Value2     'Get the schema name of the published tdv view
bdvName = mySheet.Range("B6").Value2        'Get the name of the published BDV

''''''''''Refresh data across sheets'''''''''''''
Application.ScreenUpdating = False      'Prevent screen flickering while doing the refresh
'''''''''''''''''''''''''''''''''''''''
 ''''''''''''Call sub procedure'''''''''    
Call ClearTableContents
 ''''''''''''''''''''''''''''''''''''
mySheet.Activate

Application.ScreenUpdating = True       'Prevent screen flickering while doing the refresh


''''''''Show User id and Password box'''''''''
If Len(Uid) < 1 Or Len(Password) < 1 Then
    UserForm1.Show
End If

If (cancelEvent = True) Then
    Exit Sub
End If
............
............perform some task with error handling

Ниже приведена Кодовая база вызываемого Sub

 Sub ClearTableContents()
 Dim wrksht As Worksheet
 Dim objListObj As ListObjects
 Dim tableName As String
 Dim ActiveTable As ListObject
 Dim rowCount As Integer
 Dim colCount As Integer
 Dim i As Integer
 Dim j As Integer


 '''''Iterate through the Bdv1, bdv2 and Match sheets. Set default table sizes for each 
 sheet'''''''''
 For j = 2 To 4
    If (j = 2) Or (j = 3) Then
        rowCount = 5
        colCount = 6
    ElseIf (j = 4) Then
        rowCount = 5
        colCount = 9
    End If

    Application.ScreenUpdating = False      'Prevent screen flickering while doing the refresh

    Set wrksht = ActiveWorkbook.Worksheets(j)

    Set objListObj = wrksht.ListObjects     'Get list of tables objects from the current sheet

'''''''Iterate through the tables in the active worksheet''''''''''''''
    For i = 1 To objListObj.Count
        tableName = objListObj(i).Name
        Set ActiveTable = wrksht.ListObjects(tableName)
        On Error Resume Next

''''''For each table clear the contents and resize the table to default settings''''''''''''
        With wrksht.ListObjects(i)
            .DataBodyRange.Rows.Clear
            .Range.Rows(rowCount & ":" & .Range.Rows.Count).Delete

            .HeaderRowRange.Rows.ClearContents
            .HeaderRowRange.Rows.Clear
            .Range.Columns(colCount & ":" & .Range.Columns.Count).Delete

            .Resize .Range.Resize(rowCount, colCount)
        End With
        wrksht.Columns("A:Z").AutoFit

    Next i
Next j

ThisWorkbook.Worksheets(2).Activate '''set the active sheet to the sheet number 2

Application.ScreenUpdating = True      'Prevent screen flickering while doing the refresh

Exit Sub
'Error Handling
NoTableSelected:
  MsgBox "There is no Table currently selected!", vbCritical

End Sub

Пожалуйста, помогите в решении проблемы. Если я выполняю как независимый макрос при нажатии кнопки, он работает отлично.

Answer 1

Закомментированная строка, чтобы заставить мой код работать .Range.Columns (colCount & ":" &
.Range.Columns.Count) .Delete

Answer 2

Я собираюсь опубликовать это как «ответ», так как я думаю, что это может, по крайней мере, помочь, если не решить, вашу проблему.

Очистка таблиц (списочных объектов) с помощью кода VBA может быть немного сложнее, и я усвоил этот сложный путь. Я разработал и уже давно пользуюсь приведенной ниже функцией, и она работает как шарм. Есть комментарии для объяснения кода в функции.

Sub clearTable(whichTable As ListObject)

    With whichTable.DataBodyRange

        'to trap for the bug where using 'xlCellTypeConstants' against a table with only 1 row and column will select all constants on the worksheet - can't explain more than that its a bug i noticed and so did others online
        If .rows.count = 1 And .columns.count = 1 Then
            If Not .Cells(1, 1).HasFormula Then .Cells(1, 1).ClearContents
        Else

            'my tables often have formulas that i don't want erased, but you can remove if needed
            On Error Resume Next
            .SpecialCells(xlCellTypeConstants).ClearContents
            On Error GoTo 0

        End If

        'remove extra rows so table starts clean
        Dim rowCount As Long
        rowCount = .rows.count
        If rowCount > 1 Then .rows("2:" & rowCount).Delete 'because you can't delete the first row of the table. it will always have 1 row

    End With

End Sub

Вызовите процедуру следующим образом:

Dim lo as ListObject
For each lo in Worksheets(1).ListObjects
     clearTable lo
next