Excel 名称(Name)及其 VBA 中的使用详解教程

ActiveWorkbook.Names.Add Name:="MyName", RefersToR1C1:="=Sheet1!R2C2:R6C4"
'或者
ActiveWorkbook.Names.Add Name:="MyName", RefersTo:="=Sheet1!$B$2:$D$6"

ActiveWorkbook.Names.Add Name:="Sheet1!MyName1", RefersTo:="=Sheet1!$B$2:$D$6"

Worksheets("sheet2").Names.Add Name:="MyName2", RefersTo:="=Sheet2!$A$1:$B$3"

Worksheets("Sheet1").Range("B8:C10").Name = "MyName3"

Worksheets("Sheet2").Range("H15:G16").Name = "Sheet2!MyName4"

Worksheets("Sheet1").Range("E6:F8").Name = "Sheet2!MyName5"

Worksheets("sheet2").Names.Add Name:="MyName5", RefersTo:="=Sheet1!$E$6:$F$8"

Names.Add Name:="NameNumber", RefersTo:=666

Names.Add Name:="NameString", RefersTo:="TV"

Dim MyArray(10)
Dim i As Integer
For i = 1 To 10
 MyArray(i) = i
Next i
Names.Add Name:="NameArray", RefersTo:=MyArray

Names.Add Name:="NameFormlas", RefersTo:="=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),1)"

Worksheets("Sheet2").Names("MyName5").Name = "MyName6"

Worksheets(“Sheet1”).Names.Add Selection.Name.Name,Sheet1.Range(“B3:C4”)

Evaluate("MyName").Interior.ColorIndex = 3

Names.Add Name:="HideName", RefersTo:="=$A$1:$C$3", Visible:=False

Names("MyName3").Delete

Sub test()
    Dim str As Boolean
    str = NameExists("myName")
    If str = True Then
        MsgBox "该名称存在于当前工作簿中."
    Else
        MsgBox "该名称不存在."
    End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - 
Function NameExists(FindName As String) As Boolean
    Dim rng As Range
    Dim myName As String
    On Error Resume Next
    myName = ActiveWorkbook.Names(FindName).Name
    If Err.Number = 0 Then NameExists = True
End Function

Function NameExists(TheName As String) As Boolean
    On Error Resume Next
    NameExists = Len(ThisWorkbook.Names(TheName).Name) <> 0
End Function

Sub UnHideName()
    Dim Nm As Name
    For Each Nm In Names
        Nm.Visible = True
    Next
End Sub

Sub ShowNames()
    Dim N As Integer
    For N = 1 To ActiveWorkbook.Names.Count
        On Error Resume Next
        Cells(N, 1) = "'" & ActiveWorkbook.Names(N).Name
        Cells(N, 2) = "'" & ActiveWorkbook.Names(N).RefersToRange.Address
        Cells(N, 3) = "'" & ActiveWorkbook.Names(N).ShortcutKey
        Cells(N, 4) = "'" & ActiveWorkbook.Names(N).Visible
    Next
End Sub

Sub ShowNames_activecell()
    On Error Resume Next
    MsgBox ActiveCell.Name.Name
    Select Case Err.Number
        Case 0
        Case 1004
            MsgBox "单元格" & ActiveCell.Address(4) & "没有命名。"
        Case Else
            MsgBox Err.Number & " -- " & Err.Description
    End Select
End Sub

Sub DeleteName()
    Dim Nm As Name
    For Each Nm In ActiveWorkbook.Names
        If Nm.Name Like "*name*" Then Nm.Delete
    Next Nm
End Sub

Function NameOfParentRange(Rng As Range) As String
    Dim Nm As Name
    For Each Nm In ThisWorkbook.Names
        If Rng.Parent.Name = Nm.RefersToRange.Parent.Name Then
            If Not Application.Intersect(Rng, Nm.RefersToRange) Is Nothing Then
                NameOfParentRange = Nm.Name
                Exit Function
            End If
        End If
    Next Nm
    NameOfParentRange = ""
End Function

#If Win64 Then
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
         ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As LongPtr, ByVal wMsg As Long, _
         ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
         ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
#End If
Public Const CB_SETDROPPEDWIDTH = &H160
Sub SetNameBoxDropWidth()
    Const xWidth = 600 '这里设置为你需要的宽度
    Call SendMessage( _
                     FindWindowEx( _
                         FindWindowEx( _
                             FindWindow("XLMAIN", Application.Caption), _
                         0, "EXCEL;", vbNullString), _
                     0, "combobox", vbNullString), _
                     CB_SETDROPPEDWIDTH, xWidth, 0)
End Sub

#If Win64 Then
    Public Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
         ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
#Else
    Public Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
         ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#End If
Sub SetFocusNameBox()
    Call SetFocus( _
    FindWindowEx( _
                 FindWindowEx( _
                              FindWindow("XLMAIN", Application.Caption), _
                 0, "EXCEL;", vbNullString), _
    0, "combobox", vbNullString))
End Sub