Excel Table Resize - Expand и Contract на основе извлеченных данных из базы данных - код VBA - PullRequest
0 голосов
/ 21 марта 2020

Мне нужна помощь по коду VBA для изменения размера таблиц Excel. Я написал макрос для заполнения данных в таблице Excel на том же листе и по всем листам. a) Данные извлекаются из базы данных
b) Имя таблицы базы данных представляет собой список. У пользователя есть возможность выбрать любую из перечисленных таблиц из выпадающего списка
c) После того, как пользователь нажмет Validate, заголовок таблицы заполняется именами столбцов, извлеченными из базы данных
d) Когда пользователь нажимает кнопку Import, данные таблицы заполняются
e) В зависимости от выбранного пользователем имени таблицы таблица Excel расширяется, чтобы вместить выбранный набор данных.

Пока все работает хорошо. Теперь проблема в
1) Если размер таблицы базы данных меньше, чем определено в таблице Excel, то мой Excel по-прежнему показывает дополнительные столбцы из предыдущей выборки.

Я пробовал несколько подходов, чтобы очистить содержимое дополнительных столбцов или удаление столбцов таблицы или воссоздание таблицы, но ни один из методов не выглядит хорошо и не создает мерцания на экране пользователя.

В поисках более чистого способа сброса / изменения размера таблицы как для расширения, так и для сжатия на основе количества столбцов, извлеченных из базы данных с сохранением исходного форматирования и стилей.

Любая помощь по этому вопросу приветствуется.

Public Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim tableName As String
Dim ActiveTable As ListObject
Dim lastCol As Integer
Dim startCol As Integer ' Column index to start deleting the table after reset
Dim startRow As String ' Row name to select the start range for deleting table records
Dim objCount As Integer


 startCol = 0
 'select ammount of sheets want to this to run

Application.ScreenUpdating = False      'Prevent screen flickering while doing the refresh
For i = 2 To 4
If (i = 2) Or (i = 3) Then
    startCol = 7
    startRow = "A10"
ElseIf (i = 4) Then
    startCol = 7
    startRow = "A7"
End If

Sheets(i).Select

Range(startRow).Select
Set SelectedCell = ActiveCell
Selection.AutoFilter

'Determine if ActiveCell is inside a Table
On Error GoTo NoTableSelected
objCount = ActiveSheet.ListObjects.Count

tableName = SelectedCell.ListObject.Name
Set ActiveTable = ActiveSheet.ListObjects(tableName)
On Error GoTo 0

'Clear first Row
ActiveTable.DataBodyRange.Rows(1).ClearContents

'Delete all the other rows `IF `they exist
On Error Resume Next 

 ActiveTable.DataBodyRange.Offset(1,0).Resize (ActiveTable.DataBodyRange.Rows.Count - 1, _
 ActiveTable.DataBodyRange.Columns.Count).Rows.Delete
 Selection.AutoFilter
 On Error GoTo 0


Range(tableName & "[#Headers]").Select
' Range("Table4[#Headers]").Select
Selection.ClearContents

lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count

'''''''''Autofit the columns'''''''''''

ActiveSheet.Columns("A:Z").AutoFit

'''''''''''''''delete Columns''''''''''
If (startCol < lastCol) And (i <> 4) Then
    Range(tableName & "[[#All],[Column" & startCol & "]:
 [Column" & lastCol & "]]").Select
    For j = startCol To lastCol
        Selection.ListObject.ListColumns(7).Delete
        Next j

End If

 'Execute to clear the 2nd table within the sheet as the above code is 
  handling only one table per sheet'''''
If (i = 4) Then
    Range(startRow).Select
    Set SelectedCell = Range("J7:S7")
    Selection.AutoFilter

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
    objCount = ActiveSheet.ListObjects.Count

    tableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(tableName)
    On Error GoTo 0
    Range(tableName & "[#Headers]").Select
    ' Range("Table4[#Headers]").Select
    Selection.ClearContents

    lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count
    ActiveSheet.Columns("A:Z").AutoFit
End If
Next i

ThisWorkbook.Worksheets(2).Activate

Application.ScreenUpdating = True    

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

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...