Accueil

Nommer un champ
ListeNoms
Nom Local
Nom 3D
Nom Champ Dyn
Nommer un champ en VBA
Liste des noms utilisés par des formules
Supprimer les noms inutilisés
Formulaire Suppression
Liste des commentaires et des noms des cellules

Nommer un champ

Lorsque des cellules ont étés nommées, elles peuvent être référencées par leur nom.
Les formules deviennent ainsi plus lisibles.

Sur l'exemple, nous nommons la cellule E1 (CSG):

• Sélectionner E1
• Insertion/Noms/Définir (Excel2010:Formules/Définir un nom)
• Appeler Csg
• Ecrire en C7: =B4*Csg

Noms.xls

Raccourci pour nommer une cellule ou un champ

-Sélectionner la cellule (E1)
-Frapper le nom (Csg) en haut à gauche à la place du numéro de cellule
-Valider avec Entrée

Liste des noms de champs

La commande Insertion/Noms/Coller/Coller une liste donne la liste des noms de champs

Nom Local à un onglet

-Sélectionner la cellule
-Insertion/Nom/Défnir
-Frapper NomOnglet!NomChamp

Noms de champ en 3D

-Insertion/Nom/définir
-Frapper un nom (CA3D)
-Cliquer dans référence à
-Appuyer sur Maj
-Cliquer sur juin
=Janvier:Juin!$B$2:$B$5

Noms de champ dynamique

-Insertion/Nom/Définir
-MonChamp

=DECALER($B$2;0;0;5;$M$2)

Nommer des champs en VBA

ActiveWorkbook.Names.Add Name:="ww", RefersTo:=Range("A1:A3")
ActiveWorkbook.Names.Add Name:="xxx", RefersTo:="=Feuil1!$A$1"
ActiveWorkbook.Names.Add Name:="Feuil2!yyy", RefersTo:="=Feuil2!$A$1" ' nom local à feuil2
ActiveWorkbook.Names.Add Name:="xx", RefersTo:="=12"
ActiveWorkbook.Names.Add Name:="yy", RefersTo:="={2,3,4}"
ActiveWorkbook.Names("yy").Delete
ActiveWorkbook.Names.Add Name:="xxx", RefersToR1C1:="=Sheet1!R1C1", Visible:=False
ActiveWorkbook.Names.Add Name:="zzz", RefersTo:="=feuil1!$A$1", Visible:=False

Sur cet exemple, les noms de champ sont les libellés de la première ligne

Sub NommerChamps()
  For Each c In Range([A1], [IV1].End(xlToLeft))
    If Not IsEmpty(c.Offset(1, 0)) Then
       ActiveWorkbook.Names.Add Name:=c, RefersTo:="=" & Range(c.Offset(1, 0), c.End(xlDown)).Address
    End If
  Next
End Sub

Sub NommerChampsDynamique()
  For Each c In Range([A1], [IV1].End(xlToLeft))
    If Not IsEmpty(c.Offset(1, 0)) Then
      ActiveWorkbook.Names.Add Name:=c, RefersTo:= _
       "=OFFSET(" & c.Address & ",,,COUNTA(" & c.EntireColumn.Address & ")-1)"
     End If
   Next
End Sub

Liste des noms de champ du classeur

Sub ListeNomsClasseur2()
  Dim n As Name
  i = 2
  For Each n In ActiveWorkbook.Names
    Cells(i, 1) = n.Name
    Cells(i, 2) = n
    Cells(i, 3) = n.Visible
    i = i + 1
  Next n
End Sub

Fonction liste des noms de champ

La liste est mise à jour dynamiquement.

FonctionNomsChamps

Sélectionner A2:B10
=listenoms()
Valider avec maj+ctrl+entrée

Function ListeNoms()
  Application.Volatile
  Dim n As Name
  Dim a()
  ReDim a(1 To Application.Caller.Rows.Count, 1 To 2)
  i = 1
  For Each n In ActiveWorkbook.Names
    a(i, 1) = n.Name
    a(i, 2) = n
    i = i + 1
  Next n
  ListeNoms = a
End Function

Récupérer le nom d'une cellule nommée

nom = [D7].Name.Name

Supprimer les noms de champ d'un classeur

For Each n In ActiveWorkbook.Names
   N.Delete
Next N

Supprimer les noms de champ d'une feuille

F = "feuil1"
For Each n In ActiveWorkbook.Names
  If InStr(UCase(n), UCase("=" & F & "!")) > 0 Then n.Delete
Next N

Liste des noms de champs utilisés par des formules

Le programme ci dessous donne la liste des noms de champs d'un classeur et indique s'ils sont utilisés par des formules. - Noms Champs -

Sub ListeNomsChamps()
   Application.DisplayAlerts = False
   On Error Resume Next
   Sheets("TempNoms").Delete
   On Error GoTo 0
   Sheets.Add after:=Sheets(Sheets.Count)
   ActiveSheet.Name = "TempNoms"
   [A1] = "Noms de champ"
   [C1] = "Utilisé"
   [A1:C1].Font.Bold = True
   nchamps = 0
   For Each n In ActiveWorkbook.Names
     nchamps = nchamps + 1
     Cells(nchamps + 1, 1) = n.Name
     Cells(nchamps + 1, 2) = n
   Next n
   '--- Formules qui utilisent les noms de champ
   Ligne = 1
   [E1] = "Formules utilisant les noms de champs"
   [E1].Font.Bold = True
   For s = 1 To Sheets.Count - 1
   Sheets(s).Select
   On Error Resume Next
   Sheets(s).Cells.SpecialCells(xlCellTypeFormulas, 23).Select
   If Err = 0 Then
      For Each c In Sheets(s).Cells.SpecialCells(xlCellTypeFormulas, 23)
        témoin = False
        For I = 1 To nchamps
          temp = Sheets("tempNoms").Cells(I + 1, 1)
          If InStr(temp, Sheets(s).Name & "!") > 0 Then
             temp = Mid(temp, InStr(temp, "!") + 1)
          End If
          If InStr(c.Formula, temp) > 0 Then
             Sheets("TempNoms").Cells(I + 1, 3) = True
             témoin = True
          End If
        Next I
        If témoin Then
          Ligne = Ligne + 1
          Sheets("TempNoms").Cells(Ligne, 5) = "'" & Sheets(s).Name
          Sheets("TempNoms").Cells(Ligne, 6) = "'" & c.Address
          Sheets("TempNoms").Cells(Ligne, 7) = "'" & c.Formula
        End If
      Next c
    End If
  Next s
  Sheets("TempNoms").Columns("A:K").EntireColumn.AutoFit
  Sheets("TempNoms").Select
End Sub

Supprimer les noms de champs inutilisés

Sub supNomsInutilises()
  ListeNomsChamps
  Sheets("TempNoms").Select
  For Each c In Range("A2", [A65000].End(xlUp))
    If Not c.Offset(0, 2) Then
      ActiveWorkbook.Names(c.Value).Delete
    End If
   Next c
End Sub

Formulaire de suppression de noms

SupNoms

Private Sub UserForm_Initialize()
  For Each n In ActiveWorkbook.Names
    Me.ListBox1.AddItem n.Name
  Next n
End Sub

Private Sub B_sup_Click()
   If Me.ListBox1.ListIndex <> -1 Then
     If MsgBox("Etes vous sûr de supprimer ? " & Me.ListBox1, vbYesNo) = vbYes Then
        ActiveWorkbook.Names(Me.ListBox1.Value).Delete
        Me.ListBox1.RemoveItem Me.ListBox1.ListIndex
     End If
   End If
End Sub

Suppression des noms commençant par xxxxx

Sub supnoms()
  For Each n In ActiveWorkbook.Names
     If Left(n.Name, 7) = "tableau" Then n.Delete
  Next n
End Sub

Crée un onglet avec les commentaires de la feuille active et les noms des cellules

CommentairesNoms

Sub CommentNomsChamp()
  mafeuille = ActiveSheet.Name
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("TempNoms").Delete
  On Error GoTo 0
  Sheets.Add after:=Sheets(Sheets.Count)
  ActiveSheet.Name = "TempNoms"
  MEF
  ligne = 2
  For Each c In Sheets(mafeuille).Comments
    z = nomChamp(mafeuille & "!" & c.Parent.Address)
    With Sheets("TempNoms")
      .Cells(ligne, 1) = "Cellule:"
      .Cells(ligne + 1, 1) = "Commentaire:"
      .Cells(ligne, 2) = IIf(z <> "", z, c.Parent.Address)
      .Cells(ligne + 1, 2) = c.Text
    End With
    ligne = ligne + 3
  Next c
End Sub

Function nomChamp(adr)
  For Each n In ActiveWorkbook.Names
    If Mid(n, 2) = adr Then nomChamp = n.Name
  Next n
End Function

Sub MEF()
   ActiveWindow.DisplayGridlines = False
   With Columns("A:A")
    .ColumnWidth = 14.29
    .Font.Bold = True
    .VerticalAlignment = xlTop
    .HorizontalAlignment = xlRight
  End With
  Columns("B:B").ColumnWidth = 35
End Sub