现在的位置: 首页 > Excel 杂记 > 正文

Excel 名称(Name)及其 VBA 中的使用(2)

2014年07月18日 Excel 杂记 ⁄ 共 4232字 ⁄ 字号 暂无评论 ⁄ 阅读 3,027 次
上接:Excel 名称(Name)及其 VBA 中的使用(1)

  

三、VBA 中对名称的使用实例

我们在第一部分了解和认识了名称的初步概念,在第二部分又学习了 VBA 中名称一些基本的操作,比如 添加和删除等,下面我们用一些具体的例子来进一步学习 VBA 中名称的运用

1、检查当前工作簿中某名称是否存在

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

 
2、工作簿中的所有名称可见

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

 
3、列出当前工作簿中所有名称的相关信息

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

 
4、显示当前单元格所命名的名称

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

示例说明:如果要获取指定单元格所定义的名称,可以使用Name属性两次。

 

5、删除当前工作簿中含有“name”字符的名称

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

 
6、判断某单元格或单元格区域是否与命名区域部分重叠

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

示例说明:如果Rng所代表的单元格或单元格区域与命名区域相交叉,则返回命名区域的名称,否则返回空。

  

四、有关名称的部分技巧

  

1、加大名称框的宽度

在Excel工作表的名称框中(如图1所示),大约只能显示16个字符,当超过它所能容纳的字符时,后面的字符将会被截取,将不能看到完整的名称,这对前面的字符相同而区别在最后几个字符的名称来说,很不方便,但是在Excel中没有改变名称框尺寸的设置。这可通过调用 Windows API 来解决,通过调用API来增加下拉框的宽度。在VBE编辑器中插入一个标准模块,并输入以下的代码(代码可用于 32 位和64位 Excel):

#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

效果如图:

20140718094530

示例说明:上述代码运行前后的结果如图3和图4所示。在上面的代码中,可以通过改变常量 xWidth 的值来定义下拉框的宽度。

 

2、为名称框定义快捷键

Excel提供的快捷键中没有名称框的快捷键。但是,您能使用VBA代码设置快捷键,以方便能快速定位到名称框。
在VBE编辑器中,插入一个标准模块,并输入以下代码(代码可用于 32 位和64位 Excel):

20140718100916

#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

在Excel中,选择“开发工具”选项卡 --> "组" --> “宏”命令,调出“宏”对话框,为刚创建的SetFocusNameBox代码指定快捷键,如Ctrl + Shift + O。那么,以后在该工作簿中,按下Ctrl + Shift + O组合键,即可定位到名称对话框。

给我留言

您必须 [ 登录 ] 才能发表留言!