Excel VBA以数组形式查找所有命名范围，并粘贴到表上的数据验证列中

目前我有代码（如下）在我的工作簿中查找所有图表和表格，将它们的名称作为一个数组，将它们作为数据验证下拉列表粘贴到表上，以便使用工作簿的人可以决定自动生成PowerPoint演示文稿的表格和图形现在，我正在尝试编写代码，对命名范围也将执行相同的操作。因此，不是图表或表格出于某种原因，这似乎比我逻辑上认为的要困难得多。如果我认为让表格和图表发挥作用会更令人头痛，但事实并非如此

上述表格的代码和图片如下所示

代码：

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

表格图片

---

正如你从图片上看到的；A列是我引用的地方。正如您所看到的，到目前为止，我为工作簿命名的一个图表显示得很好——因此，到目前为止，我的图形和表格代码似乎工作得很好我现在只需要它在同一列上填充命名范围A

此工作簿。名称

包含对工作簿中包括命名范围在内的所有名称的引用

我编写了一个函数将命名范围添加到数组中

代码 用法

---

我相信你会想循环使用

名称。i、 e.
用于此工作簿中的每个nme。名称
。。。直接取自Excel VBA，因此在Excel VBA中使用函数时我非常不熟悉，那么我如何将这段代码放到上面的代码中，让函数应该创建的数组填充到我的数据验证表中，就像我对图表和表格所做的一样？@ajcarrozza Change
设置结果（计数）=Target
到您希望在数组中存储的任何内容（例如
结果（计数）=Name.Name&“-”&Target.Parent.Name&“-”&Named Range&
）。
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)