Microsoft 365 Liste nom onglet

[juju91]

Bonjour,

J'ai encore besoin de votre aide .

Je souhaiterais pouvoir nommer les onglets d'un fichier via une liste qui se trouve dans un feuille ''synthèse'' qui se trouve aussi dans le même fichier.
Sachant que j'ai des macro qui utilise le nom des onglets .
auriez-vous une solution.

Par avance merci.

 

[job75]

Bonjour juju91,

Les noms des onglets sont dans la liste, dites clairement ce que vous voulez faire.

A+

 

[juju91]

Désolé,
j'ai du mal m'exprimer.
je souhaite que si je change la valeur de l'une des cellules le nom de l'onglet change et corresponde à la nouvelle valeur de la cellule modifié.
A+

 

[Dranreb]

Bonjour.
Ajoutez ça dans le module Feuil1 (Synthèse) :

Private Sub Worksheet_Activate()
   Dim T(), Obj As Object, N As Integer
   ReDim T(1 To ThisWorkbook.Sheets.Count, 1 To 1)
   For Each Obj In ThisWorkbook.Sheets
      If Obj.Name <> Me.Name Then N = N + 1: T(N, 1) = Obj.Name
      Next Obj
   Me.Cells(3, "A").Resize(UBound(T, 1)).Value = T
   End Sub

 

[Dranreb]

Ah, c'est l'inverse que vous voudriez aussi pouvoir faire.
Alors :

Private Sub Worksheet_Activate()
   Dim Rng As Range, M As Integer, T(), Obj As Object, N As Integer
   Set Rng = Me.[A3].Resize(Me.Cells(2 ^ 20, "A").End(xlUp).Row - 2)
   M = ThisWorkbook.Sheets.Count - 1: If M > Rng.Rows.Count Then Set Rng = Rng.Resize(M)
   ReDim T(1 To Rng.Rows.Count, 1 To 1)
   For Each Obj In ThisWorkbook.Sheets
      If Obj.Name <> Me.Name Then N = N + 1: T(N, 1) = Obj.Name
      Next Obj
   Application.EnableEvents = False
   Rng.Value = T
   Application.EnableEvents = True
   End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range, N As Integer, Obj As Object, M As Integer
   Set Rng = Me.[A3].Resize(Me.Cells(2 ^ 20, "A").End(xlUp).Row - 2)
   If Target.CountLarge > 1 Or Intersect(Rng, Target) Is Nothing Then Exit Sub
   N = Target.Row - 2
   For Each Obj In ThisWorkbook.Sheets
      If Obj.Name <> Me.Name Then M = M + 1
      If M = N Then Exit For
      Next Obj
   On Error Resume Next
   Obj.Name = Target.Value
   End Sub

 

[Dranreb]

Bon, alors il y avait deux sortes de bouton: un bouton de formulaire et un bouton ActiveX, alors moi je vous ai mis deux bouton d'une seule sorte mais un peu intermédiaire entre les deux …

 

[job75]

Hello Bernard,

Ma solution qui affiche les noms de toutes les feuilles :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Activate()
Dim tablo(), n
ReDim tablo(1 To Sheets.Count, 1 To 1)
For n = 1 To Sheets.Count
    tablo(n, 1) = Sheets(n).Name
Next
n = n - 1
Application.EnableEvents = False
With [A3]
    .Resize(n) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, n, mem$
Set P = Range("A3", Cells(Rows.Count, 1).End(xlUp))
If P.Row < 3 Or Intersect(Target, P) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Application.CountIf(P, "Synthèse") * Application.CountIf(P, "Client 1") * Application.CountIf(P, "Client 2") = 0 Then Application.Undo: GoTo 1 'noms à adapter
For Each Target In Target
    n = Target.Row - 2
    mem = Sheets(n).Name
    On Error Resume Next
    Sheets(n).Name = Target
    Sheets(CStr(Target)).Cells.Replace mem, Target, xlPart 'modifie le contenu de la feuille
Next
1 Application.EnableEvents = True
End Sub