Test sur le nom éventuel d'une cellule

Dim c As Range, x$
Set c = ActiveCell 'pour tester
x = ""
On Error Resume Next
x = c.Name.Name
MsgBox "Cellule " & c.Address(0, 0) & IIf(x = "", " sans nom", " nommée '" & x & "'")

Dim c As Range, flag As Boolean, nom As Name
Set c = ActiveCell 'pour tester
flag = False
For Each nom In ThisWorkbook.Names
  If TypeName(Evaluate(nom.Name)) = "Range" Then
    If Evaluate(nom.Name).Parent.Name = c.Parent.Name Then
      If Not Intersect(c, Evaluate(nom.Name)) Is Nothing Then
        flag = True
        MsgBox c.Address(0, 0) & IIf(Evaluate(nom.Name).Count > 1, " appartient à la plage nommée '", " est nommée '") & nom.Name & "'"
      End If
    End If
  End If
Next
If Not flag Then MsgBox c.Address(0, 0) & " n'appartient à aucune plage nommée"