Discussion :

[Pompaero]

Bonjour le forum

Depuis un bon moment d'absence ici je suis fier de revenir sur ce type de forum. Je me suis remis à construire (enfin j'essai..) des petits fichiers pour le taf ou j'ai la responsabilité de mettre en place des systèmes simplifiés pour la traçabilité dans le cadre d'une certification (ça c'est ma vie, vous vous en foutez peu être ), bon je reviens à mes moutons.

Le fichier joint concerne le suivi des Note de Frais, j'ai pas mal avancé grace au forum ou j'ai trouvé les exemples qui m'on ammené à ce résultat, mais la je commence à patoger dans la construction des macros.
Donc je viens vers vous pour avoir un peu d'aide si vous le voulez bien?
L'objectif est de renseigner la Note de Frais, la sauvegarder en faisant une copie puis masquer. (Je suis arrivé un peu prêt à ce résultat avec des montages maison ).
J'aimerai que quelqu'un puisse vérifier et aménager mes macros dont je résume si après :
* Module 2
Macro NouvelleFeuille = construit seul, elle sert à copier la Note de Frais sur un autre onglet, sauvegarder puis masquer
Macro Macro1 = Créer un bouton à l'ouverture des onglets masquer (Note de frais 15/001, ect..) afin de pouvoir le remasquer.
* Module 3
Macro SelctionFeuille = Créer un lien en colonne A de la feuille "Recherche" afin de démasquer l'onglet correspondant au N° (à arranger)
Macro NomIncrement = Incrémenter automatiquement les Note de Frais.
Le numéro incrémenté serait avec les 2 derniers chiffre de l'année en cour suivi d'un "-" puis le chiffre 001 et 002 et 003 et ect.... C'est numéros reviendront à 001 à chaque changement d'année.
ex : fiche 15-001, fiche 15-002, fiche 15-003, ect jusqu'à la fin de l'année puis
fiche 16-001, fiche 16-002, ect...
Voilà mes explications qui j'espère sont assez claire, pour mieux comprendre je mets mon fichier en PJ.

Merci à vous tous

---

Fichiers joints dans les discussions

---

[pasdechances]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
sub question()
if msgbox ("Tu veux de l'aide pour qu'on te fasse le boulot ?" ,VBYESNO,"que veux tu réelement ?") = VBNO then
    msgbox "je te prierai de bien vouloir nous exposer ton code" & _ 
             "(en te servant des balises faites pour) et nous dire"  & _ 
             "ou tu bloque afin que l'on puisse t'aider =)." ,vbOKOnly,""
    else
    msgbox "il te reste les tutos ou les idots. " ,vbOKOnly,""
end if
end sub

[Pompaero]

Bonjour pasdechances.

Le speuso est inquiétant !! , je plaissante bien sûr.

Désolé si je n'est pas été précis dans mon post. Mais comme il y a plusieurs choses j'ai préféré mettre le fichier afin que vous puissiez vous rentre compte de l'utilisation.
Donc je pars sur le point dans Module 3 ===> Macro NumIncrement qui pour moi servirai à numéroter les notes de frais comme ceci (15-001, 15-002, 15-003, ect….), le 15 correnspond aux 2 derniers chiffres de l'année en cours suivi des numéros 001, 002, ect.. ceci jusqu'à la fin de l'année puis au changement d'année on recommence comme ceci (16-001, 16-002, ect...
Je me permet de ne pas mettre de code ici car je ne sais pas si il faut un lien avec les autres macros et préfére que vous voyez le fichier complet (dans post précédent) pour son fonctionnement, cela est plus parlant ( enfin je trouve, pour moi).
Merci encore pour l'aide

cdlt

[pasdechances]

Je suis désolé, mais je n'ouvrirait pas ton fichier excel, pour les simples raisons que :
1- je ne suis pas chez moi
2- je n'utilise donc pas mon pc
3- c'est en dernier recours que tu peut te permettre de joindre ton fichier

cela dit tu peut toujours nous exposer ton code grâce au balise de code, c'est le petit "#" pour la mise en forme ^^ ou le [CODE][/CODE]

[Pompaero]

Re

Je comprends bien ta situation alors voici mon code. "tu as le droit de rigoler mais pas de ce moquer !!! )

Code :

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

1
2
3
4
5
6
7
8
Sub NumIncrement() 'Incrémentation des fiches à sauvegarder
Dim An, Serie
 
An = Format(Sheets("Acceuil").Range("H4"), "yy")  'Récupère les 2 derniers chiffres de l'année
Serie  '(= série de numéros 001, 002, 003, ect)
Num = Sheets("Note").Range("J1") = An & "-" & Serie
 
End Sub

Cdlt

[pasdechances]

Merci,

bon tu as plusieurs possibilité.

Code :

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

range("h:h").NumberFormat = "00-000"

après tu met se que tu veux dans cellule et sa donnera le résultat que tu attend

[Pompaero]

merci

je mets ce code à la suite de Serie = range("h:h").NumberFormat = "00-000" c'est bien ça ?

petite question ? pourquoi ("h:h") ?

[pasdechances]

non tu devra mettre :

Code :

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

1
2
3
4
5
6
7
8
 
'rang("h:h") équivault dire "pour toute la colonne H"
'le numberformat = c'est pour dire " le format sera : "
range("h:h").NumberFormat = "00-000"
 
An = Format(Sheets("Acceuil").Range("H4"), "yy")  'Récupère les 2 derniers chiffres de l'année
Serie  = serie +1
num = Sheets("Note").Range("J1") = An & Serie

sauf que, je viens de voir un truc, ça marchera pas vraiment comme tu veux,
Je voulais aller au plus simple, mais pas possible au final.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'rang("h:h") équivault dire "pour toute la colonne H"
'le numberformat = c'est pour dire " le format sera : "
range("h:h").NumberFormat = "00-000"
 
An = Format(Sheets("Acceuil").Range("H4"), "yy")  'Récupère les 2 derniers chiffres de l'année
Serie  = serie +1
 
if serie >= 10 then numserie = "0" & serie
if serie < 10 then numserie = "00" & serie
 
num = Sheets("Note").Range("J1") = An & numserie

ou alors tu peut faire comme tu as commencer du coup :

Code :

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

1
2
3
4
5
6
7
An = Format(Sheets("Acceuil").Range("H4"), "yy")  'Récupère les 2 derniers chiffres de l'année
Serie  = serie +1
 
if serie >= 10 then numserie = "0" & serie
if serie < 10 then numserie = "00" & serie
 
num = Sheets("Note").Range("J1") = An & "-" & numserie

ou même :

Code :

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

1
2
3
4
5
cells(i,1).NumberFormat =  Format(Sheets("Acceuil").Range("H4"), "yy") & "-000"
 
Serie  = serie +1
 
num = Sheets("Note").Range("J1") = numserie

[Pompaero]

Re

Merci pour les propositions, mais désolé j'essai de construire mais je sent que j'y suis presque, je te résume :
Sur ma feuille "Note" qui sert de modèle il y a un bouton sauvegarder et quand je click cela donne :

Copie du modèle "Note" sur nouveau onglet renommé avec les numéros 15-001, ect... l'onglet 15-001 est masquer puis reviens sur la feuille "Note"
et c'est à se moment la qu'intervient ma macro Increment pour renuméroté la prochaine Note à remplir.
Donc j'ai tenté avec tes propositions cela :

Code :

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

1
2
3
4
5
6
7
8
Sub NumIncrement() 'Incrémentation des fiches à sauvegarder
Dim Serie, num, An  'Est ce que les variables sont bien définies  (j'en suis pas sur) ???
 
Serie = Sheets("Recherche").[A65000].End(xlUp).Row  'Recherche de la dernière ligne remplie dans la colonne A sur feuille "Recherche" ou sont enregistrer les numéros pour futur recherche.
Serie = Serie + 1
An = Format(Sheets("Acceuil").Range("H4"), "yy") & "-000"  'on donne le format de la cellule H4 sur feuille "Note" en prenant le 15 de l'année
num = Sheets("Note").Range("J1") = An & "-" & Serie
End Sub

désolé pour le cafouillage !!

[Invité]

Bonjour ,

Code :

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

1
2
3
 
Serie = Sheets("Recherche").[A65000].End(xlUp).Row  'Recherche de la dernière ligne remplie dans la colonne A sur feuille "Recherche" ou sont enregistrer les numéros pour futur recherche.
Serie = Serie + 1

Code :

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

1
2
 
Serie = Sheets("Recherche").[A65000].End(xlUp).Row + 1 'Recherche de la dernière ligne remplie dans la colonne A sur feuille "Recherche" ou sont enregistrer les numéros pour futur recherche.

Tu veux récupérer Vrai/Faut?

Code :

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

num = Sheets("Note").Range("J1") = An & "-" & Serie

Code :

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

1
2
 
 Sheets("Note").Range("J1") = Format(Sheets("Acceuil").Range("H4"), "yy-000-") & Serie

[Pompaero]

bonjour rdurupt

merci de me venir également en renfort car la je commence à patauger sérieusement .
je viens d'essayer tes propositions mais cela Bug, je pense qu'il il a conflit avec la mise en place du futur numéro et le dernier numéro enregistré, (mais pas certain)

tes codes que je viens de faire :

Code :

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

1
2
3
4
5
6
Sub NumIncrement() 'Incrémentation des fiches à sauvegarder
Dim Serie As Range 
 
Serie = Sheets("Recherche").[A65000].End(xlUp).Row + 1
Sheets("Note").Range("J1") = Format(Sheets("Acceuil").Range("H4"), "yy-000-") & Serie
End Sub

Ca bug sur Serie=Sheets("Recherche").[A65000].End(xlUp).Row + 1.
Le résultat est presque la, mais l'incrémentation doit s'effectuer sur les 3 dernier chiffres seulement car les 2 premier sont l'année et je pense que c'est la que ça bloque. (mais c'est juste une pensée)

[Invité]

Code :

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

1
2
3
4
5
6
Sub NumIncrement() 'Incrémentation des fiches à sauvegarder
Dim Serie As integer 
 
Serie = Sheets("Recherche").cells(cells.rows.count,"A").End(xlUp).Row + 1
Sheets("Note").Range("J1") = Format(Sheets("Acceuil").Range("H4"), "yy-000-") & Serie
End Sub

[Pompaero]

Re

vraiment désolé de passer pour une cruche !!

rdurupt, ton code fonctionne en liaison avec les numéros de ligne mais se n'est pas exactement ce que je veux, sincèrement désolé mais on y est presque.

Je résume ce que je voudrai : il y a 3 feuilles (pour cette macro)
* feuille "Accueil" ou je trouve la date du jour en H4
* feuille "Recherche" ou j'enregistre les numéros de fiche en colonne A (à partir de A3)
* feuille "Note" qui me sert de modèle pour créer les note de frais.
j'aimerai créer les n° de note de frais (feuille "Note"en J1) comme ceci 15-001, 15-002, ect.. le 15 correspond au 2 dernier chiffre de l'année (pris en H4 feuil accueil).
la série de n° 001, 002, ect est a créer donc dans la macro NumIncerment. et a chaque changement d'année on redémare avec le 001, 002, ect avec l'année devant (16-001, 16-002, ect)

faudrait au changement d'année que le n° 001 se crée tout seul car tout ces n° sont stocké en colonne A sur la feuille "Recherche" (a partir de A3).

exemple feuille "Recherche" :

A3 --> 15-001
A4 --> 15-002 <--- juste incrémenter A3 le 001 + 1
A5 --> 15-003 idem A4 002 + 1
ect...
A10 --> 15-007
nous sommes le 15 janvier 2016
A11 --> 16-001 <---- le 001 se crée d'office.
A12 --> 16-002 <--- on recomence incrémenter A11 le 001 + 1
ect... idem A12 002 + 1

voila voilou.

je met mon fichier en PJ pour mieux se rendre compte.
Pièce jointe 188684
Grand merci à vous
Cdlt

[Philippe Tulliez]

Bonjour,
Pour incrémenter un n° de facture, note d'envoi, offre, etc., il suffit d'avoir une fonction qui renvoie le n° suivant et se remet à 1 lors d'un changement d'année, trimestre, mois, etc. et ce en fonction d'argument passé à la fonction. Ensuite on passe par le formatage de cette numérotation.
Ce sont deux choses différentes

Une fonction à télécharger avec fichier exemple Excel - Incrémenter un numéro de facture, devis, à l'aide d'une fonction personnalisée.

[Theze]

Bonjour,

En utilisant l'incrémentation automatique d'Excel peut être ? Admettons que dans la cellule H1 se trouve la valeur 15-001, l'exécution de la procédure va automatiquement inscrire 15-002 dans la cellule H2. Quand on sera le 1er janvier 2016, l'incrémentation va passée à 16-001 :

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
 
Sub NumIncrement()
 
    Dim Cel As Range
 
    'dernière cellule non vide dans la colonne H
    Set Cel = ActiveSheet.Cells(Rows.Count, 8).End(xlUp)
 
    If Left(Cel.Value, 2) < Right(Year(Date), 2) Then
 
        'initialise le début de l'incrémentation pour la nouvelle année
        Cel.Offset(1).Value = Right(Year(Date), 2) & "-" & "001"
 
    Else
 
        'incrémente
        Cel.AutoFill Range(Cel, Cel.Offset(1))
 
    End If
 
End Sub

[Pompaero]

Bonjour Theze

Merci à toi aussi de me venir en aide.

Je viens de tester ta macro qui fonctionne bien dans le principe que je veux (je commence à retrouver le sourire , cool) mais il reste tout de même un petit soucis à la nouvelle procédure du coup, j'explique :
dans ma macro (si dessous, je simplifie)
--> je complète la note (feuille modèle), déclenche ma macro qui
--> Copie la feuille modele sur un autre onglet avec en cellule J1 le numéro de fiche ensuite
--> reviens sur la feuille modele ou se vide certaines cellule (donc prête à remplir une nouvelle fiche)
Vu que ta macro incrémente automatique les fiches, le souci maintenant c'est que je ne récupère plus le numéro suivant dans la feuille modèle (ce numéro sert à nommer les onglets), Donc serait-il possible dans ta macro ou dans une autre macro de pouvoir afficher le prochain numéro de fiche à enregistrer (peu être à l'activation de la feuille) ?

comme promis je mets ma procédure :

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub NouvelleFeuille()
Dim Nom As String
Dim Ws As Worksheet
Dim ligne As String
Dim MaPlage As Range, Cel As Range
Dim DernLigne As Long
 
Set MaPlage = Sheets("Note").Range("D5,N5,N7:N8,D34")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next
 
  If MsgBox("Voulez-vous continuer la sauvegarde ?", vbQuestion + vbYesNo, "confirmation") = vbNo Then Exit Sub
Range("J9").Select
 
  Application.ScreenUpdating = False
   Set Ws = ActiveSheet
   Nom = "Fiche n° " & Range("J1").Value
 
  If FeuilleExiste(Nom) = True Then 'si feuille existe déjà alors message
     If MsgBox("Ce n° de fiche existe déjà." & Chr(10) & "Enregistrement annulé.", vbInformation + vbOKOnly, "Information") = vbOK Then Exit Sub
  Else
     ligne = Sheets("Recherche").[B65000].End(xlUp).Row + 1
   '--- Transfert Feuil ("Note") dans Feuil ("Recherche")
     'Sheets("Recherche").Cells(ligne, 1) = Sheets("Note").Range("J1")
     Sheets("Recherche").Cells(ligne, 2) = CDate(Sheets("Note").Range("N7"))
     Sheets("Recherche").Cells(ligne, 3) = CDate(Sheets("Note").Range("N8"))
     Sheets("Recherche").Cells(ligne, 4) = Sheets("Note").Range("D5")
     Sheets("Recherche").Cells(ligne, 5) = Sheets("Note").Range("D6")
     Sheets("Recherche").Cells(ligne, 6) = Sheets("Note").Range("N5")
     Sheets("Recherche").Cells(ligne, 7) = Format(Sheets("Note").Range("N7"), "yyyy")
     Sheets("Recherche").Cells(ligne, 8) = Now
 
  Sheets("Note").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
      .Name = Nom                'Nomme nouvelle feuill "Fiche n° + cellule J1
      .DrawingObjects.Delete     'Supprime les objets (boutons)
      .Visible = False           'Masque la feuille
    End With
  End If
 
  NumIncrement
 
  Ws.Select  'feuille "Note"
    Range("D5:E5,J5:K7,N5:O6,N7:O8,B16:G30,I16:N30,D34:E35,J36:J37").ClearContents
 
    'Sheets("Note").Range("J1") = Feuil2.[h2].Value & "-" & Format(Feuil2.[g2].Value, "0##") 'A supprimer si nouvelle macro incrémente
End Sub

Je continu mes essais puis de chercher.


PS : ta macro deviens pour moi comme ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub NumIncrement()
    Dim Cel As Range
 
    'dernière cellule non vide dans la colonne A de la feuille "recherche"
    Set Cel = Sheets("Recherche").Cells(Rows.Count, 1).End(xlUp)
    'Set Cel = ActiveSheet.Cells(Rows.Count, 8).End(xlUp)  'colonne H
    If Left(Cel.Value, 2) < Right(Year(Date), 2) Then
        'initialise le début de l'incrémentation pour la nouvelle année
        Cel.Offset(1).Value = Right(Year(Date), 2) & "-" & "001"
    Else
        'incrémente
        Cel.AutoFill Range(Cel, Cel.Offset(1))
    End If
End Sub

Merci encore
Cdlt

[Theze]

Donc, si j'ai bien compris, tu veux incrémenter pour nommer les nouvelles feuilles ,
Je te propose alors une fonction qui va trouver le bon numéro afin d'avoir une suite dans les fiches et qui prend en compte le changement d'année :
ton code avec l'appel de la fonction (ligne 28) :

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Sub NouvelleFeuille()
 
Dim Nom As String
Dim Ws As Worksheet
Dim ligne As String
Dim MaPlage As Range, Cel As Range
Dim DernLigne As Long
 
Set MaPlage = Sheets("Note").Range("D5,N5,N7:N8,D34")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next
 
  If MsgBox("Voulez-vous continuer la sauvegarde ?", vbQuestion + vbYesNo, "confirmation") = vbNo Then Exit Sub
Range("J9").Select
 
Application.ScreenUpdating = False
Set Ws = ActiveSheet
 
'_____________________________________________________________
'ici, la fonction est appelée pour créer le bon numéro...
Nom = "Fiche n° " & Numero()
'_____________________________________________________________
 
     ligne = Sheets("Recherche").[B65000].End(xlUp).Row + 1
   '--- Transfert Feuil ("Note") dans Feuil ("Recherche")
     'Sheets("Recherche").Cells(ligne, 1) = Sheets("Note").Range("J1")
     Sheets("Recherche").Cells(ligne, 2) = CDate(Sheets("Note").Range("N7"))
     Sheets("Recherche").Cells(ligne, 3) = CDate(Sheets("Note").Range("N8"))
     Sheets("Recherche").Cells(ligne, 4) = Sheets("Note").Range("D5")
     Sheets("Recherche").Cells(ligne, 5) = Sheets("Note").Range("D6")
     Sheets("Recherche").Cells(ligne, 6) = Sheets("Note").Range("N5")
     Sheets("Recherche").Cells(ligne, 7) = Format(Sheets("Note").Range("N7"), "yyyy")
     Sheets("Recherche").Cells(ligne, 8) = Now
 
  Sheets("Note").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
      .Name = Nom                'Nomme nouvelle feuill "Fiche n° + cellule J1
      .DrawingObjects.Delete     'Supprime les objets (boutons)
      .Visible = False           'Masque la feuille
    End With
 
  NumIncrement
 
  Ws.Select  'feuille "Note"
    Range("D5:E5,J5:K7,N5:O6,N7:O8,B16:G30,I16:N30,D34:E35,J36:J37").ClearContents
 
End Sub

Et ci dessous, la fonction (à mettre dans le module avec ton 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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Function Numero() As String
 
    Dim Fe As Worksheet
    Dim AnneeMax As Integer
    Dim Annee As Integer
    Dim NumMax As Integer
    Dim Num As Integer
 
    'première boucle pour connaître l'année la plus grande
    For Each Fe In Worksheets
 
        If InStr(Fe.Name, "-") <> 0 Then
 
            Annee = Split(Fe.Name, "-")(0)
 
            If Annee > AnneeMax Then AnneeMax = Annee
 
        End If
 
    Next Fe
 
    'seconde boucle pour rechercher le numéro le plus grand de l'année en cours (la plus grande)
    For Each Fe In Worksheets
 
        If InStr(Fe.Name, "-") <> 0 Then
 
            Annee = Split(Fe.Name, "-")(0)
 
            If Annee = AnneeMax Then
 
                Num = Split(Fe.Name, "-")(1)
 
                If Num > NumMax Then NumMax = Num
 
            End If
 
        End If
 
    Next Fe
 
    'si c'est une nouvelle année, initialise
    If AnneeMax < Right(Year(Date), 2) Then
 
        Numero = Right(Year(Date), 2) & "-001"
 
    'sinon, retourne le numéro disponible pour l'année en cours
    Else
 
        Numero = AnneeMax & Format(NumMax + 1, "-000")
 
    End If
 
End Function

[Pompaero]

Bonjour Theze

Oh la la !!! ben la je commence sérieusement à planer, je ne sais plus ou j'en suis Lol

Je viens d'essayer tes macros mais ça bug à ce niveau

Code :

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

Annee = Split(Fe.Name, "-")(0)

perso je vois pas ou tu récupère la date dans cette Fonction ?

Cdlt

[Theze]

Bonjour,

Désolé, je suis parti sur des noms de feuille comme ceci "15-001" et non comme "Fiche n° 15-001" donc effectivement, plantage !
Voici la fonction rectifiée. Je tronque la première partie du nom (Fiche n° ) afin de n'avoir plus que la partie qui nous intéresse (15-001) :

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 
Function Numero() As String
 
    Dim Fe As Worksheet
    Dim AnneeMax As Integer
    Dim Annee  As Integer
    Dim NumMax As Integer
    Dim Num As Integer
    Dim Nom As String
 
    'première boucle pour connaître l'année la plus grande
    For Each Fe In Worksheets
 
        If InStr(Fe.Name, "-") <> 0 Then
 
            'tronque "Fiche n° " pour n'avoir plus que "15-001"
            Nom = Right(Fe.Name, Len(Fe.Name) - InStr(Fe.Name, "°") - 1)
 
            Annee = Split(Nom, "-")(0)
 
            If Annee > AnneeMax Then AnneeMax = Annee
 
        End If
 
    Next Fe
 
    'seconde boucle pour rechercher le numéro le plus grand de l'année en cours (la plus grande)
    For Each Fe In Worksheets
 
        If InStr(Fe.Name, "-") <> 0 Then
 
            'tronque "Fiche n° " pour n'avoir plus que "15-001"
            Nom = Right(Fe.Name, Len(Fe.Name) - InStr(Fe.Name, "°") - 1)
 
            Annee = Split(Nom, "-")(0)
 
            If Annee = AnneeMax Then
 
                Num = Split(Nom, "-")(1)
 
                If Num > NumMax Then NumMax = Num
 
            End If
 
        End If
 
    Next Fe
 
    'si c'est une nouvelle année, initialise
    If AnneeMax < Right(Year(Date), 2) Then
 
        Numero = Right(Year(Date), 2) & "-001"
 
    'sinon, retourne le numéro disponible pour l'année en cours
    Else
 
        Numero = AnneeMax & Format(NumMax + 1, "-000")
 
    End If
 
End Function

[Pompaero]

Bonjour Theze

Bravo pour la déduction du bug, te confirme que cela fonctionne maintenant.

Grand merci pour ton aide et je n'oublie pas également pasdechance, rdurupt et Philippe Tulliez pour leur contribution.

je vais clôturer ce post puis en ouvrir un autre avec un sujet different mais toujours pour le même fichier.

A bientôt peu être et encore merci.

Cdlt