onglet changeant de titre

[dadou060606]

bonjour a tous

j aimerais savoir comment changer automatiquement le titre d un onglet et la couleur
sur l exemple j ai marque sur l onglet 2 ce que j aimerais qu il y ai marque c est a dire donnees!b6 et ainsi de suite
et que ca me colorie l onglet en noir si il y a un nom et en rouge si il n y en a pas

j espere que vous m aiderez

bonnes fetes a tous

 

[DoubleZero]

Re : onglet changeant de titre

Bonjour, dadou060606, le Forum,

Peut-être avec ce code, placé dans "ThisWorkbook" :

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
If ActiveSheet.Name <> "données" Then ActiveSheet.Name = "FACT " & Range("f8").Value
If ActiveSheet.Name = "FACT 0" Then ActiveSheet.Tab.Color = 255
If ActiveSheet.Name <> "données" And ActiveSheet.Name <> "FACT 0" Then ActiveSheet.Tab.ThemeColor = xlThemeColorLight1
End Sub

A bientôt 🙂

 

[job75]

Re : onglet changeant de titre

Bonjour dadou060606, bonjour DoubleZero 🙂

A placer dans le code de ThisWorkbook (Alt+F11) :

Private Sub Workbook_Open()
Dim c As Range, w As Worksheet
'---suppression des espaces superflus (il y en avait !!!)---
For Each c In Sheets("données").Range("B5", Sheets("données").[B65536].End(xlUp))
  c = Application.Trim(c) 'SUPPRESPACE
Next
'---nom des onglets---
For Each w In Worksheets
  Workbook_SheetChange w, w.[F8]
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim c As Range, i As Integer
If Left(Sh.Name, 4) = "FACT" Then
  If Not Intersect(Source, Sh.[F8]) Is Nothing Then
    Set c = Sheets("données").[B:B].Find(Sh.[F8], , xlValues, xlWhole)
    On Error Resume Next
    If c Is Nothing Or Sh.[F8] = "" Then
      Do
        i = i + 1
        Sh.Name = "FACT " & i
        If Sh.Name = "FACT " & i Then Exit Do
      Loop
      Sh.Tab.ColorIndex = 3 'rouge
    Else
      Sh.Name = "FACT =données!" & c.Address(0, 0)
      If Sh.Name <> "FACT =données!" & c.Address(0, 0) Then _
        MsgBox "Le nom '" & c & "' en " & Sh.Name & "!F8 est déjà utilisé !"
      Sh.Tab.ColorIndex = 1 'noir
    End If
  End If
End If
End Sub

Les noms des onglets "FACT..." sont revus à l'ouverture du fichier et quand on modifie la cellule F8.

Nota : il y avait des espaces superflus dans les noms de la feuille "données" c'est pourquoi je les supprime dans la 1ère macro.

Fichier joint.

A+

 

[job75]

Re : onglet changeant de titre

Re,

Bon, c'est probablement plutôt ces noms d'onglets que vous voulez :

Private Sub Workbook_Open()
Dim c As Range, w As Worksheet
'---suppression des espaces superflus (il y en avait !!!)---
For Each c In Sheets("données").Range("B5", Sheets("données").[B65536].End(xlUp))
  c = Application.Trim(c) 'SUPPRESPACE
Next
'---nom des onglets---
For Each w In Worksheets
  Workbook_SheetChange w, w.[F8]
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim c As Range, i As Integer
If Left(Sh.Name, 4) = "FACT" Then
  If Not Intersect(Source, Sh.[F8]) Is Nothing Then
    Set c = Sheets("données").[B:B].Find(Sh.[F8], , xlValues, xlWhole)
    On Error Resume Next
    If c Is Nothing Or Sh.[F8] = "" Then
      Do
        i = i + 1
        Sh.Name = "FACT " & i
        If Sh.Name = "FACT " & i Then Exit Do
      Loop
      Sh.Tab.ColorIndex = 3 'rouge
    Else
      Sh.Name = "FACT " & c
      If Sh.Name <> "FACT " & c Then _
        MsgBox "Le nom '" & c & "' en " & Sh.Name & "!F8 est déjà utilisé !"
      Sh.Tab.ColorIndex = 1 'noir
    End If
  End If
End If
End Sub

Fichier (2).

A+

 

[job75]

Re : onglet changeant de titre

Re,

J'espère que vous aurez compris ceci : la cellule F8 des feuilles "FACT..." ne doit pas être renseignée par formule.

Mais manuellement, afin de rechercher sa valeur en colonne B de la feuille "données".

A+

 

[job75]

Re : onglet changeant de titre

Re,

Quelques améliorations dans votre fichier :

- liste de validation en F8 des fichiers "FACT..."

- cette liste étant créée par cette macro dans la feuille "données" :

Private Sub Worksheet_Deactivate()
Dim P As Range
Set P = Range("B6", [B65536].End(xlUp))
[O2:O65536].ClearContents 'RAZ
If P.Row > 5 Then
  [O2].Resize(P.Rows.Count) = P.Value
  [O2].Resize(P.Rows.Count).Sort [O2], Header:=xlNo 'tri
End If
[O2].Resize(Application.Max(Application.CountA(P), 1)).Name = "Liste"
End Sub

- formules avec RECHERCHEV en F9 et F10.

Fichier (3).

A+

 

[dadou060606]

Re : onglet changeant de titre

merci a tous c est topissime
je vais commencer l annee sur de bon rail
par contre je n arrive pas a le reproduire sur ma feuille reelle de calcul
si quelqu un peut m expliquer calmement