Discussion :

[Un Internaute]

Félicitations à vous deux.
Juste un petit problème ça accroche à la ligne ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Tab.ColorIndex = Couleur((An - 2000) Mod 12)

Si je la met en commentaires plus de débogage mais la couleur est la même pour chaque onglet.
Encore une question: Comment fait-on pour que le bouton Nouvelle Série suive la nouvelle feuille?
Un grand merci à vous 2
Un dernier petit effort!!!!
Bien cordialement

[Un Internaute]

J'ai légèrement modifié mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Sub NouvellesSeances()
Dim NomFeuille As String
Dim An As Integer, sh As Shape
Dim Couleur
 
  Couleur = Array(3, 5, 43, 6, 7, 33, 29, 27, 38, 46, 26, 6)
  An = Application.InputBox("Numéro de la nouvelle Série", Type:=1)
  If An = 0 Then MsgBox "Entrez un Nombre": Exit Sub
  With ActiveSheet
    .Unprotect
    NomFeuille = "Série " & An
    .Copy after:=Sheets(Sheets.Count)
  End With
  With ActiveSheet
    .Name = "Serie " & An
    .Shapes("SeancesPlus").Delete
'    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Protect
  End With
End Sub

[casefayere]

...Comment fait-on pour que le bouton Nouvelle Série suive la nouvelle feuille?...

je ne comprends, c'est toi qui décide de le supprimer avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Shapes("SeancesPlus").Delete

sinon enlèves cette ligne ou parles-tu d'un autre bouton ?

sinon pour l'autre problème je te propose

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
.....
    .Tab.ColorIndex = Couleur(Sheets.Count)
 
.....

[Un Internaute]

Lorsqu'on change quelque chose il y a de la "casse" dans les macros!
Presque tout fonctionne mais j'ai oublié de dire.
Lorsque je supprime le 1 toute la ligne doit s'effacer mais là un hic dans Série 2 (nouvelle feuille) et dans la macro ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Range("B9:B" & Rows.Count), Target) Is Nothing Then
    Range("A" & Target.Row) = IIf(Target = "", "", Date)
    If Target = "" Then
      Target.Interior.ColorIndex = Target.Offset(0, -1).Interior.ColorIndex
      Target.Offset(0, 1).Resize(1, 4).ClearContents
    End If
  End If
End Sub

Ligne : Target.Interior.ColorIndex = Target.Offset(0, -1).Interior.ColorIndex
Débogage

[casefayere]

tu es en train de parler d'un autre sujet, as-tu résolu les autres problèmes ? si oui dis-le, après je regarderai ton nouveau soucis si j'ai le temps car j'ai de la visite

[Un Internaute]

Oui tout le reste fonctionne bien.
Toutes mes excuses c'est dans "l'euphorie" de voir que tout fonctionne.
Prend ton temps et surtout un grand merci.
Nous sommes des éternels apprentis"!!!
Bonne fin de soirée
Bien cordialement

[casefayere]

regardes l fichier que je t'envoie et essayes de trouver ce qui as changé, quant à ton dernier problème, je n'ai pas eu de bug en essayant

[Un Internaute]

Ah! oui tu l'as mis dans le ThisWorbook
Je m'excuse vraiment de t'avoir fait passer le jour de l'Ascension devant le clavier!!!
Tout fonctionne parfaitement.
Bonne fin de soirée
Cordialement à toi.

[casefayere]

Bonjour,

Je m'excuse vraiment de t'avoir fait passer le jour de l'Ascension devant le clavier!!!

Pas de problème, je vais très bientôt rejoindre ton clan (Retraité), en vacances en attendant

Bonne journée

[Un Internaute]

Bienvenue au club alors!

Je te remercie encore ainsi que Daniel.C

Bonnes vacances en attendant.
Bien cordialement