Numérotation et incrémentation des onglets au format "TEXTE" + Num
Bonjour,
Voilà le contexte : je gère un service de contrôle. Nous rédigeons des rapports à l'année N et les reprenons à l'année N+1. Dans ce cadre, on va remplir une FICHE (une feuille), puis la dupliquer autant que nécessaire en la numérotant (incrémentant) à chaque fois. On peut aussi être amené à insérer une nouvelle FICHE entre 2 existantes ou en supprimer une. La numérotation des fiches ne suit donc plus.
EX : on passe de Fiche n°1 -2 - 3 - 4 - 5 à Fiche n°1 - 5 - 3 - 2.
J'ai réussi à créer une macro à partir d'existantes trouvées sur différents forums (bidouille). Ca marche super mais je ne comprend pas forcément tous les termes et mécanismes. Ca me permet chaque fois qu'on clique sur un bouton "Ajouter une fiche", d'ajouter une nouvelle fiche (feuille) tout en contrôlant et remettant la numérotation de toutes les FICHES dans l'ordre de position des onglets qui sont eux aussi renommés en fonction de leur position.
Pour le moment le nom des onglets est au format "000", "001" etc...
J'aimerais passer à un format "Fiche N°001", FICHE N°002" etc.... (car un autre fichier m'attend et je devrais différencier le type de fiche en les nommant différemment)
Comment je fais pour expliquer à VBA qu'il doit inscrire "FICHE N°" devant le numéro "000" dans l'onglet ?
A noter :
- il n'effectue l'opération que dans les onglets/feuilles contenant le texte "Fiche N°" en G9 (il existe d'autres onglets qui ne doivent pas bouger)
- il doit ensuite me récupérer le numéro de l'onglet pour l'insérer dans la cellule I9 (Numéro de Fiche dans la cellule = numéro de l'onglet)
D'avance merci de Savoie !
Sub Ajouterunefiche()
Dim Ws As Worksheet, Num As Integer
Set Ws = ActiveSheet
Num = Ws.Name
Ws.Copy After:=Ws
ActiveSheet.Name = Num + 1
Range("Q9:S9").Select
Selection.ClearContents
Range("H22:S41").Select
Selection.ClearContents
Range("N46:Q555").Select
Selection.ClearContents
Range("Q9").Select
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim X As Integer 'déclare la variable X (incrément)
Application.EnableEvents = False 'bloque les procédures événementielles
X = 1 'inititalise la variable X
For Each O In Sheets 'boucle sur tous les onglets O du classeur
'condition 1 : si la cellule B3 de l'onglet contient : "Fiche N° "
If O.Range("G9").Value = "Fiche N°" Then
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
O.Name = CStr(Format(X, "000")) 'définit le nom de l'onglet (génere une erreur si ce nom existe déjà)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
'renomme l'onglet portant le même nom en metant "Provi " devant
Sheets(CStr(Format(X, "000"))).Name = "Provi " & CStr(Format(X, "000"))
O.Name = CStr(Format(X, "000")) 'définit le nom de l'onglet
End If 'fin de la condition 2
O.Range("I9").Value = O.Name 'récupère le nom de l'onglet dans la cellule C8
On Error GoTo 0 'annule la gestion des erreurs
X = X + 1 'incrémente X
End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
Application.EnableEvents = True 'permet les procédures événementielles
End Subbonjour
O.Name = "FICHE N°" & Format(X, "000")
Bonjour Nyto007 et
Une petite présentation ICI pourrait être la bienvenue
Voici le code
Sub Ajouterunefiche()
Dim Ws As Worksheet, Num As Integer
Dim sNomF As String
' Initialisation du numéro de fiche
Num = 0
' Faire tant que aucune erreur
Do
' Définir le nom
sNomF = "FICHE N°" & Format(Num, "000")
' En cas d'erreur
On Error Resume Next
' Vérifier is la feuille existe
Set Ws = Sheets(sNomF)
' incrémenter le numéro de feuille
Num = Num + 1
Loop While Err.Number = 0
' Gestion normale des erreurs
On Error GoTo 0
' Nouveau nom
sNomF = "FICHE N°" & Format(Num - 1, "000")
Ws.Copy After:=Ws
ActiveSheet.Name = sNomF
'
Range("Q9:S9").ClearContents
Range("H22:S41").ClearContents
Range("N46:Q555").ClearContents
Range("Q9").Select
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim X As Integer 'déclare la variable X (incrément)
Application.EnableEvents = False 'bloque les procédures événementielles
X = 1 'inititalise la variable X
For Each O In Sheets 'boucle sur tous les onglets O du classeur
'condition 1 : si la cellule B3 de l'onglet contient : "Fiche N° "
If O.Range("G9").Value = "Fiche N°" Then
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
O.Name = CStr(Format(X, "000")) 'définit le nom de l'onglet (génere une erreur si ce nom existe déjà)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
'renomme l'onglet portant le même nom en metant "Provi " devant
Sheets(CStr(Format(X, "000"))).Name = "Provi " & CStr(Format(X, "000"))
O.Name = "FICHE N°" & Format(X, "000") 'définit le nom de l'onglet
End If 'fin de la condition 2
O.Range("I9").Value = O.Name 'récupère le nom de l'onglet dans la cellule C8
On Error GoTo 0 'annule la gestion des erreurs
X = X + 1 'incrémente X
End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
Application.EnableEvents = True 'permet les procédures événementielles
End SubPerso, pas besoin de ta routine
For Each O in Sheetssi tu le fais au début lors de la création
Edit : oups, bonjour h2so4, je ne pense pas que ce soit aussi simple
@+
Bonjour Bruno,
Merci pour la présentation et pour la routine (c'est bon j suis dans les règles édictées ?) :)
je viens de faire le test et il bloque sur
Ws.Copy After:=WsPerso, pas besoin de ta routine
<b>For</b> <b>Each</b> O <b>in</b> Sheetssi tu le fais au début lors de la création
Que veux tu dire par là ?
Salut et merci H2so4 - en effet pas si simple !
Re,
Pour moi, si j'ai bien compris, il y a 2 procédures distinctes
Celle pour créer directement un nouvelle fiche avec le bon nom (code corrigé à essayer)
Sub Ajouterunefiche()
Dim Ws As Worksheet, Num As Integer
Dim sNomF As String
' Initialisation du numéro de fiche
Num = 0
' Faire tant que aucune erreur
Do
' Définir le nom
sNomF = "FICHE N°" & Format(Num, "000")
' En cas d'erreur
On Error Resume Next
' Vérifier is la feuille existe
Set Ws = Sheets(sNomF)
' incrémenter le numéro de feuille
Num = Num + 1
Loop While Err.Number = 0
' Gestion normale des erreurs
On Error GoTo 0
' Nouveau nom
sNomF = "FICHE N°" & Format(Num - 1, "000")
Set Ws = Sheets(sNomF)
Ws.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = sNomF
.Range("Q9:S9").ClearContents
.Range("H22:S41").ClearContents
.Range("N46:Q555").ClearContents
.Range("Q9").Select
End With
' Effacer la variable objet pour libérer la mémoire
Set Ws = Nothing
End SubEt celle pour la mise à jour des fiches déjà existantes
Sub MàJ_NomOnglet()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim X As Integer 'déclare la variable X (incrément)
Application.EnableEvents = False 'bloque les procédures événementielles
X = 1 'inititalise la variable X
For Each O In Sheets 'boucle sur tous les onglets O du classeur
'condition 1 : si la cellule B3 de l'onglet contient : "Fiche N° "
If O.Range("G9").Value = "Fiche N°" Then
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
O.Name = CStr(Format(X, "000")) 'définit le nom de l'onglet (génere une erreur si ce nom existe déjà)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
'renomme l'onglet portant le même nom en metant "Provi " devant
Sheets(CStr(Format(X, "000"))).Name = "Provi " & CStr(Format(X, "000"))
O.Name = "FICHE N°" & Format(X, "000") 'définit le nom de l'onglet
End If 'fin de la condition 2
O.Range("I9").Value = O.Name 'récupère le nom de l'onglet dans la cellule C8
On Error GoTo 0 'annule la gestion des erreurs
X = X + 1 'incrémente X
End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
Application.EnableEvents = True 'permet les procédures événementielles
End Sub@+
En effet, la 1ère procédure sert à ajouter une feuille en incrémentant. La seconde procédure sert remettre toute la numérotation des onglets + fiches lorsqu'on insert une nouvelle feuille entre 2. Ce qui est pratique quand tu génères 50 fiches... plutôt que d'avoir à tout remettre à la main.
Merci encore. Il bug toujours, il n'aime pas, je ne comprend pas.
bonjour à tous,
Edit : oups, bonjour h2so4, je ne pense pas que ce soit aussi simple
j'ai sans doute lu trop vite.
H2so4, non finalement j'ai réussi à me débrouiller avec le format que tu m'as donné.
Je sais que ma procédure n'est pas pure, mais je ne fais que bidouiller et le principal c'est que ça marche ! Ce sont mes gars qui vont être content :)
Merci à vous 2