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 :

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, test As Boolean, A As Application, n
Set P = Range("A3", Cells(Rows.Count, 1).End(xlUp))
If Intersect(Target, P) Is Nothing Then Exit Sub
test = Application.CountIf(P, "Synthèse") * Application.CountIf(P, "Client 1") * Application.CountIf(P, "Client 2") = 0 'noms à adapter
Set A = Application: If test Or A.CountA(P) <> Sheets.Count Then A.EnableEvents = False: A.Undo: A.EnableEvents = True: Exit Sub
For Each Target In Target 'si entrées multiples (copier-coller
    n = Target.Row - 2
    On Error Resume Next
    Sheets(n).Name = Target 'renomme la feuille
    If Err = 0 Then Sheets(n).Cells.Replace Sheets(n).Name, Target, xlWhole, MatchCase:=False 'modifie le contenu de la feuille
Next
End Sub