VBA/Excel/Access/Word/Excel/Name

Материал из VB Эксперт
Перейти к: навигация, поиск

Adding Comments for a name

   <source lang="vb">

Sub addcomment()

   ActiveWorkbook.Worksheets("Sheet7").Names("LocalOffice").rument = "text"

End Sub

</source>
   
  


A name can also store the data stored in an array.

   <source lang="vb">

Sub NamedArray()

   Dim myArray(10, 5)
   Dim i As Integer, j As Integer
   For i = 1 To 10
       For j = 1 To 5
           myArray(i, j) = i + j
       Next j
   Next i
   Names.add name:="FirstArray", RefersTo:=myArray

End Sub

</source>
   
  


Checking for the Existence of a Name

   <source lang="vb">

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
   Else
       NameExists = False
   End If

End Function

</source>
   
  


Check Name existance

   <source lang="vb">

Sub Main()

 If NameExists("SalesData") Then
   MsgBox "Name Exists"
 Else
   MsgBox "Name does not exist"
 End If

End Sub Function NameExists(myName As String) As Boolean

 Dim X As String
 On Error Resume Next
 X = Names(myName).RefersTo
 If Err.Number <> 0 Then
   NameExists = False
   Err.Clear
 Else
   NameExists = True
 End If

End Function

</source>
   
  


Define a name by hard code the cell address

   <source lang="vb">

Sub DefineName1a()

 ActiveWorkbook.names.Add Name:="NameArea", RefersToR1C1:="=sheet1!R1C1:R3C1"

End Sub

</source>
   
  


Determining which Names Overlap a Range

   <source lang="vb">

    Sub SelectionEntirelyInNames()
        Dim sMessage As String
        Dim nmName As name
        Dim rngNameRange As range
        Dim rng As range
        On Error Resume Next
        For Each nmName In Names
            Set rngNameRange = Nothing
            Set rngNameRange = nmName.RefersToRange
            If Not rngNameRange Is Nothing Then
                If rngNameRange.Parent.name = ActiveSheet.name Then
                   Set rng = Intersect(Selection, rngNameRange)
                   If Not rng Is Nothing Then
                       If Selection.Address = rng.Address Then
                           sMessage = sMessage & nmName.name & vbCr
                       End If
                   End If
                End If
            End If
        Next nmName
        If sMessage = "" Then
            MsgBox "The selection is not entirely in any name"
        Else
            MsgBox sMessage
        End If
    End Sub
</source>
   
  


Enables access to named ranges in arbitrary workbooks

   <source lang="vb">

Sub ChangeValueInNamedCell2()

 Dim rng As Range
 Set rng = Evaluate(ActiveWorkbook.names("CellXy").Name)
 rng.Value = "This is a named cell."
 Debug.Print rng.Value

End Sub

</source>
   
  


Fill named range with values

   <source lang="vb">

Sub FillNameArea1()

 Application.Goto Reference:=ActiveWorkbook.Names("NameArea").Name
 Selection.value = "Test1"

End Sub Sub FillNameArea2()

 Evaluate(ActiveWorkbook.Names("NameArea").value).value = "Test2"

End Sub

</source>
   
  


find out which names are overlapping the selected cells, regardless of whether they entirely contain the selected cells

   <source lang="vb">

    Sub NamesOverlappingSelection()
        Dim sMessage As String
        Dim nmName As name
        Dim rngNameRange As range
        Dim rng As range
        On Error Resume Next
        For Each nmName In Names
            Set rngNameRange = Nothing
            Set rngNameRange = range(nmName.name)
            If Not rngNameRange Is Nothing Then
                If rngNameRange.Parent.name = ActiveSheet.name Then
                   Set rng = Intersect(Selection, rngNameRange)
                   If Not rng Is Nothing Then
                           sMessage = sMessage & nmName.name & vbCr
                   End If
                End If
            End If
        Next nmName
        If sMessage = "" Then
            MsgBox "The selection is not entirely in any name"
        Else
            MsgBox sMessage
        End If
    End Sub
</source>
   
  


Generate named range from Range object

   <source lang="vb">

Sub BuildNameFromRange()

 Dim rng As Range
 Set rng = ActiveWorkbook.Sheets("sheet1").[A1].CurrentRegion
 ActiveWorkbook.Names.Add Name:="NameArea", RefersTo:="=" + rng.Address(External:=True)
 Debug.Print Range("NameArea").Address(External:=True)

End Sub

</source>
   
  


Generate Range object from named range

   <source lang="vb">

Sub BuildRangeFromName()

 Dim rng As Range
 Set rng = Evaluate(ActiveWorkbook.names("NameArea").Value)
 Debug.Print rng.Address(External:=True)

End Sub

</source>
   
  


Go to a name

   <source lang="vb">

Sub GotoName2()

 Application.Goto Reference:= ActiveWorkbook.names("NameArea").Name, Scroll:=True

End Sub

</source>
   
  


Hide a name by setting its Visible property to False

   <source lang="vb">

Sub nameRef()

    Names.add name:="StoreNumber", RefersTo:=v, Visible:=False

End Sub

</source>
   
  


Hide the name after it has been created:

   <source lang="vb">

Sub vis()

    Names("StoreNumber").Visible = False

End Sub

</source>
   
  


Insert hidden name

   <source lang="vb">

Public Sub InsertHiddenName()

 Names.Add Name:="PassWord", RefersTo:="Bazonkas", Visible:=False

End Sub

</source>
   
  


Is Name In Workbook

   <source lang="vb">

Option Explicit Public Function IsNameInWorkbook(ByVal Name As String) As Boolean

  Dim X As String
  Dim aRange As Range
 
  Application.Volatile
  On Error Resume Next
  Set aRange = Application.Caller
  Err.Clear
  
  If aRange Is Nothing Then
     X = ActiveWorkbook.Names(Name).Name
  Else
     X = aRange.Parent.Parent.Names(Name).Name
  End If
  
  If Err.Number = 0 Then IsNameInWorkbook = True

End Function Public Sub TestName()

 If IsNameInWorkbook(InputBox("What Name")) Then
   MsgBox "Name exists"
 Else
   MsgBox "Name does not exist"
 End If

End Sub

</source>
   
  


Names Overlapping Selection

   <source lang="vb">

Public Sub NamesOverlappingSelection()

 Dim Message As String
 Dim aName As Name
 Dim NameRange As Range
 Dim aRange As Range

 On Error Resume Next
 For Each aName In Names
   Set NameRange = Nothing
   Set NameRange = Range(aName.Name)
   If Not NameRange Is Nothing Then
     If NameRange.Parent.Name = ActiveSheet.Name Then
       Set aRange = Intersect(Selection, NameRange)
       If Not aRange Is Nothing Then
         Message = Message & aName.Name & vbCr
       End If
     End If
   End If
 Next aName
 If Message = "" Then
   Debug.Print "No Names are overlapping the selection"
 Else
   Debug.Print Message
 End If

End Sub

</source>
   
  


Range objects cannot be used with an worksheet object as superobject

   <source lang="vb">

Sub ChangeValueInNamedCell1()

 Range("CellXy").Value = "CellXy"
 Debug.Print Range("CellXy").Value

End Sub

</source>
   
  


Retrieving Values Stored as a Workbook Name Using the Evaluate Method

   <source lang="vb">

Sub TestWorkbookNameValue()

   Dim vValue As Variant 
   vValue = Application.Names("SalesTaxRate").RefersTo 
   Debug.Print "Value retrieved using RefersTo: " & vValue 

End Sub

</source>
   
  


Searching for a Name

   <source lang="vb">

    Function IsNameInWorkbook(sName As String) As Boolean
        Dim s As String
        Dim rng As range
        Application.Volatile
        On Error Resume Next
        Set rng = Application.Caller
        Err.clear
        If rng Is Nothing Then
            s = ActiveWorkbook.Names(sName).name
        Else
            s = rng.Parent.Parent.Names(sName).name
        End If
        If Err.Number = 0 Then IsNameInWorkbook = True
    End Function
    Sub TestName()
          If IsNameInWorkbook(InputBox("What Name")) Then
          MsgBox "Name exists"
          Else
          MsgBox "Name does not exist"
          End If
    End Sub
</source>
   
  


Searching for the Name of a Range

   <source lang="vb">

    Sub TestNameOfRange()
        Dim nmName As name
        On Error Resume Next
        Set nmName = Selection.name
        If nmName Is Nothing Then
            MsgBox " Selection has no name"
        Else
            MsgBox nmName.name
        End If
    End Sub
</source>
   
  


Selection Entirely In Names

   <source lang="vb">

Public Sub SelectionEntirelyInNames()

 Dim Message As String
 Dim aName As Name
 Dim NameRange As Range
 Dim aRange As Range
 On Error Resume Next
 
 For Each aName In Names
   Set NameRange = Nothing
   Set NameRange = aName.RefersToRange
   If Not NameRange Is Nothing Then
     If NameRange.Parent.Name = ActiveSheet.Name Then
       Set aRange = Intersect(Selection, NameRange)
       If Not aRange Is Nothing Then
         If Selection.Address = aRange.Address Then
           Message = Message & aName.Name & vbCr
         End If
       End If
     End If
   End If
 Next aName
 If Message = "" Then
   MsgBox "The selection is not entirely in any name"
 Else
   MsgBox Message
 End If

End Sub

</source>
   
  


Select named range

   <source lang="vb">

Sub GotoName1()

 Application.Goto Reference:= _
   ActiveWorkbook.names("NameArea").Name

End Sub

</source>
   
  


specify that the Names collection belongs to a worksheet:

   <source lang="vb">

Sub nameAdd()

   Worksheets("Sheet1").Names.add name:="F", RefersToR1C1:="=Sheet1!R1C1:R6C6"

End Sub

</source>
   
  


Store formulas into names. The formula must start with an equals sign (=).

   <source lang="vb">

Sub addName()

    Names.add name:="ItemsInA", RefersTo:="=COUNTA($A:$A)"

End Sub

</source>
   
  


storing a formula in a name is the same as for a range

   <source lang="vb">

Sub addName()

   Names.add name:="Product", RefersTo:="=OFFSET(Sheet2!$A$2,0,0,COUNTA(Sheet2!$A:$A))"

End Sub

</source>
   
  


Storing Values in Names

   <source lang="vb">

Sub var()

    Dim v As Variant
    v = 3.14159
    Names.add name:="StoreNumber", RefersTo:=v
    v = "Sales"
    Names.add name:="StoreString", RefersTo:=v

End Sub

</source>
   
  


use names to store numbers between sessions

   <source lang="vb">

Sub store()

   NumofSales = 5123
   Names.add name:="TotalSales", RefersTo:=NumofSales
    "Or use this:
   Names.add name:="TotalSales", RefersTo:=5123

End Sub

</source>
   
  


use the Evaluate method equivalent to evaluate the name in VBA:

   <source lang="vb">

Sub itemA()

    Names.add name:="ItemsInA", RefersTo:="=COUNTA($A:$A)"
    MsgBox [ItemsInA]

End Sub

</source>
   
  


Using named ranges of cells

   <source lang="vb">

Option Explicit Sub DefineName1()

 Range("A3:B5").Name = "TestArea"
 Debug.Print Range("TestArea").Address(External:=True)

End Sub

</source>
   
  


Using the Names Object to List All Named Ranges

   <source lang="vb">

Sub TestListNames()

  ListWorkbookNames ThisWorkbook, ThisWorkbook.Worksheets(2).range("a2")

End Sub Sub ListWorkbookNames(wb As Workbook, rgListStart As range)

   Dim nm As name
   For Each nm In wb.Names
       rgListStart.value = nm.name
       rgListStart.Offset(0, 1).value = """ & nm.RefersTo
       Set rgListStart = rgListStart.Offset(1, 0)
   Next

End Sub

</source>