excel - 用于命名范围的 VBE 智能感知

Question

从 VBE Intellisense 获取工作表的命名范围的最佳做法是什么？

我已经创建了一个从工作表的类模块获取命名范围的解决方法，但我认为这太费力了，从下面的代码可以看出，它在 Sheet1 类模块中。有什么可以替代更少的代码？

Sub MY_SUB()
    Dim rg As Excel.Range
    Set rg = Me.frFirstPayment
    rg.Select
End Sub

Function frFirstPayment() As Excel.Range
    Set frFirstPayment = Me.Range("FirstPayment")
End Function

Function frClientAddress() As Excel.Range
    Set frClientAddress = Me.Range("ClientAddress")
End Function

根据 SO Tim Williams 的评论进行编辑

以下是我如何生成报告表的各种命名范围:

1 - 将以下过程复制并粘贴到标准模块中(我给它提供了一个快捷栏图标快捷方式链接)。

2 - 激活您想要获取其所有命名范围的工作表。

3 - 从 VBE 或单击快速栏图标运行程序。

4 - 将剪贴板粘贴到事件表类模块中。

5 - 现在，输入“set rg = me.z”，然后从 Intellisense 中选择所需的命名范围。

Sub Named_Ranges_Properties_Sheet_Class_Module_To_Clipboard()
    Dim r As Name, propName As String, strOut As String, ws As Worksheet, obj As New DataObject
    Set ws = ActiveSheet
    'BUILD THE STRING OUTPUT
    For Each r In ActiveWorkbook.Names
        If Excel.Range(r).Parent.Name = ws.Name Then
            propName = "z" & r.Name
            strOut = strOut & _
            "Property Get " & propName & "() As Excel.Range" & vbNewLine & _
            vbTab & "Set " & propName & " = Me.Range(""" & r.Name & """)" & vbNewLine & _
            "End Property" & vbNewLine
        End If
    Next r
    'UPLOAD TO THE CLIPBOARD
    If Len(strOut) > 0 Then
        obj.SetText strOut
        obj.PutInClipboard
        MsgBox "Ok"
    Else
        MsgBox "Activesheet has no named range."
    End If
End Sub

下面我们有第二种形式的代码，它使用冒号语句“:”生成“紧凑”代码(每个属性一行代码)。

Sub NAMED_RANGES_PROPERTIES_SHEET_CLASS_MODULE_TO_CLIPBOARD_()
    Dim r As Name, propName As String, strOut As String, ws As Worksheet, obj As New DataObject, k As Integer
    Set ws = ActiveSheet
    'BUILD THE STRING OUTPUT
    For Each r In ActiveWorkbook.Names
        If Excel.Range(r).Parent.Name = ws.Name Then
            k = k + 1
            propName = "z" & r.Name
            strOut = strOut & _
            "Property Get " & propName & "() As Excel.Range: Set " & propName & " = Me.Range(""" & r.Name & """)" & ": End Property" & vbNewLine
        End If
    Next r
    'UPLOAD TO THE CLIPBOARD
    If k > 0 Then
        obj.SetText strOut
        obj.PutInClipboard
    End If
    'MESSAGE BOX
    MsgBox k & " named rage(s) found."
End Sub

Answer 1

是这样的吗？

Enum Ranges
    FirstPayment = 0
    ClientAddress = 1
End Enum

Property Get NamedRange(NameIndex As Integer) As String
  Dim RangeNames As Variant
  RangeNames = Array("FirstPayment", "ClientAddress")
  NamedRange = CStr(RangeNames(NameIndex))
End Property
    
...
    Set frFirstPayment = Me.Range(NamedRange(Ranges.ClientAddress))
...

也许太笨重了？枚举很棒，但仅限于数字