VBA для поиска всех именованных диапазонов в виде массива и вставки в столбец проверки данных в таблице.

В настоящее время у меня есть код (ниже), который просматривает и находит все диаграммы и таблицы в моей книге , принимает их имена в виде массива и вставляет их в таблицу в виде раскрывающегося списка проверки данных, чтобы тот, кто использует книгу, мог решить, какие таблицы и графики для автоматического создания в презентации PowerPoint. Теперь я пытаюсь написать код, который будет делать то же самое для именованных диапазонов. Так что не графики или таблицы. По какой-то причине это кажется намного сложнее, чем я логически предполагал. Во всяком случае, я полагал, что заставить работать таблицы и диаграммы было бы больше головной болью, но этого не произошло.

Code and Picture of the aforementioned table are shown below

КОД:

Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim xlTable As ListObject
Dim xlTableColumn As ListColumn
Dim xlChartObject As ChartObject
Dim xlTableObject As ListObject

Dim ObjectArray() As String
Dim ObjectIndexArray As Integer

Dim ExcRng As Range

'set the book
Set xlBook = ThisWorkbook

'loop through each worksheet
For Each xlSheet In xlBook.Worksheets

    'if we have charts
    If xlSheet.ChartObjects.Count > 0 Then
    
        'grab each chart name
        For Each xlChartObject In xlSheet.ChartObjects
        
            'update count
            ObjectArrayIndex = ObjectArrayIndex + 1
            ReDim Preserve ObjectArray(ObjectArrayIndex)
            
                'add the chart object to array
                ObjectArray(ObjectArrayIndex) = xlChartObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlChartObject)
            
            
        Next
    End If
    
    'if we have tables
    If xlSheet.ListObjects.Count > 0 Then
    
        'grab each table name
        For Each xlTableObject In xlSheet.ListObjects
        
            'update count
            ObjectArrayIndex = ObjectArrayIndex + 1
            ReDim Preserve ObjectArray(ObjectArrayIndex)
            
                'add the table object to array
                ObjectArray(ObjectArrayIndex) = xlTableObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlTableObject)
            
            
        
        Next
    End If
Next

'grab sheet
Set xlSheet = xlBook.Worksheets("Export")
    
    'grab table from sheet
    Set xlTable = xlSheet.ListObjects("ExportToPowerPoint")
    
        'grab object column from table
        Set xlTableColumn = xlTable.ListColumns("Object")
        
            'set the validation dropdown
            With xlTableColumn.DataBodyRange.Validation
            
                'delete old
                .Delete
                
                'add new data
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(ObjectArray, ",")
                
                'make sure it's a dropdown
                .InCellDropdown = True
                
            End With

ИЗОБРАЖЕНИЕ ТАБЛИЦЫ

Изображение 16044

Как видно на картинке; столбец A - это то место, где у меня идут ссылки. И, как вы можете видеть, одна диаграмма и таблица, которые я назвал до сих пор для своей книги, отображаются нормально - так что мой код для графиков и таблиц, похоже, работает отлично. Теперь мне просто нужно, чтобы он также заполнял именованные диапазоны в том же столбце A

# excel
Источник
  • 0
    Я верю, что вы захотите зациклить Names т.е. For Each nme In ThisWorkbook.Names ... взяты непосредственно из этого сообщения
Codelisting
за 1 против
Лучший ответ

ThisWorkbook.Namesсодержит ссылку на все имена в книге, включая именованные диапазоны.

Я написал функцию для добавления именованных диапазонов в массив.

Код

Function GetNamedRanges(SheetName As String) As Variant()
    Dim Results As Variant
    ReDim Results(1 To ThisWorkbook.Names.Count)
        
    Dim Count As Long
    Dim Name As Name
    Dim Target As Range
    For Each Name In ThisWorkbook.Names
        On Error Resume Next
        Set Target = Name.RefersToRange
        If Err.Number = 0 Then
            If Target.Parent.Name = SheetName Or Len(SheetName) = 0 Then
                Count = Count + 1
                Set Results(Count) = Target
                On Error GoTo 0
            End If
        End If
    Next
    ReDim Preserve Results(1 To Count)
    GetNamedRanges = Results
End Function

использование

AllNames = GetNamedRanges
Sheet1Names = GetNamedRanges(Sheet1.Name)
  • 0
    Итак, я довольно незнаком, когда дело доходит до использования функций в Excel VBA, так как бы мне взять этот блок кода здесь и поместить его в свой код выше, чтобы массив, который функция должна создать, заполнял мою таблицу проверки данных, как у меня что делать с моими диаграммами и таблицами?
  • 0
    @ajcarrozza Изменить Set Results(Count) = Target счетчик) = Таргетинг на то, что вы хотите сохранить в массиве (например, Results(Count) = Name.Name & "-" &Target.Parent.Name & "-" & Named Range" & .
Codelisting
Популярные категории
На заметку программисту