Compteur se réintialisant en début d'année
Bonsoir le forum,
J'ai un probleme récurant que je n'arrive pas à résoudre.
Je crée en ce moment de nombreux fichiers avec l’impression via un userform, d'une fiche papier transmise au service concerné. Actuellement je crée mon numéro de la fiche par "l'année & numéro de la ligne ."
La première année cela fonctionne nickel par contre au changement d'année je me retrouve avec un numéro de Fiche :
2018359 pour une fiche émise le 02/01/2018 au lieu de 2018001.
J'ai déjà tenté plein de contournement mais le résultat n'est pas au rendez vous :
je vous laisse ici un aperçut de mon meilleur code....
Private Sub CommandButton1_Click()
Dim a As Integer, b As Integer, i As Integer, j As Integer, x As Integer
Application.ScreenUpdating = FalseIf TextBox1.Value <> "" Then
If ComboBox1.Value <> "" Then
If Range("Liste_N°UH").Find(ComboBox1.Value) Is Nothing Then
Range("UH_à_créer").Offset(Range("UH_à_créer").Rows.Count, 0).Resize(1, 1) = ComboBox1.Value
x = 1
End If
If ListBox1.ListIndex > -1 Then
If ComboBox3.Value <> "" Then
If TextBox3.Value <> "" Then
If ComboBox4.Value <> "" Then
With Sheets("DATA")
.Unprotect Password:="xx"
i = .Range("A" & Rows.Count).End(xlUp).Row + 1.Cells(i, 1).Value = Format(Now, "yyyy")
.Cells(i, 2).Value = Format(Now, "' mm")
.Cells(i, 3).Value = Format(Now, "' dd")
.Cells(i, 4).Value = Format(Now, "' hh:nn")
.Cells(i, 5) = TextBox1.Value
.Cells(i, 6) = ComboBox1.Value
.Cells(i, 7) = Sheets("Paramètres").Cells(ComboBox1.ListIndex + 2, 5).Value
With Me.ListBox1
For j = 0 To .ListCount - 1
If .Selected(j) = True Then
Sheets("DATA").Cells(i, 8).Value = Sheets("DATA").Cells(i, 8).Value & .List(j) & " / "
End If
Next j
End With
.Cells(i, 9).Value = ComboBox3.Value
.Cells(i, 10).Value = TextBox2.Value
.Cells(i, 11).Value = TextBox3.Value
.Cells(i, 12).Value = ComboBox4.Value
.Protect Password:="xx"
End With
Application.DisplayAlerts = False
Sheets("Edition").Copy After:=Sheets(6)
Sheets("Edition (2)").Name = "Printasupr"
With Sheets("Printasupr")
.Unprotect Password:="xx"
.visible = True
.Select
.Cells(7, 4).FormulaR1C1 = "Fiche de non-conformité n° : " & Format(Now, "yyyy") & "_" & iIf x <> 1 Then
[Dest] = "Service : " & Sheets("Paramètres").Cells(ComboBox1.ListIndex + 2, 5).Value
Else
[Dest] = "Service : En cours de Création"
End If
[NUH] = "UH : " & ComboBox1.Value
[NOM] = TextBox1.Value
[EXAM] = TextBox3.Value
[SERV] = ComboBox3
[CONT] = TextBox2.Value
[Date] = Format(Now, "dd/mm/yyyy")
With Me.ListBox1
a = 22
b = 0
For j = 0 To .ListCount - 1
If .Selected(j) = True Then
Cells(a, 3) = .List(j)
a = a + 1
b = Sheets("Paramètres").Cells(ListBox1.ListIndex + 2, 3).Value
If Sheets("Paramètres").Cells(ListBox1.ListIndex + 1, 3).Value <> "" Then b = b + 1
End If
Next j
End With
If b = 0 Then
.Cells(35, 1).FormulaR1C1 = "l'absence de non conformité critique a permis le traitement de la demande"
Else
.Cells(35, 1).FormulaR1C1 = "Au moins une non conformité critique est signalée sur cette fiche,"
.Cells(36, 1).FormulaR1C1 = "pour cette raison l'examen ne pourra pas être réalisé."
End If
Sheets("Printasupr").PrintOut
.Protect Password:="xx"
End With
Sheets("Printasupr").Delete
ActiveWorkbook.Save
Application.DisplayAlerts = True
Unload Me
reouvre
Else
MsgBox ("Selectionnez votre nom")
End If
Else
MsgBox ("Examen manquant")
End If
Else
MsgBox ("Appel non renseigné")
End If
Else
MsgBox ("Selectionnez la ou les NC")
End If
Else
MsgBox ("Saisir l'UH")
End If
Else
MsgBox ("Saisir le nom & le prenom ou le Nip du patient")
End If
Application.ScreenUpdating = True
End Sub
Si vous avez une petite piste ou un exemple qui pourrai répondre à mon problème,
Merci,
Bonjour,
En l'absence de fichier, on ne peut que supputer...
i = .Range("A" & Rows.Count).End(xlUp).Row + 1Ça c'est ce qui renvoie ta dernière ligne : tant que tu n'auras pas effacé toutes les lignes ça te renverra toujours 357 !!!
On peut supposer que tu as une évènementielle liée au changement d'année...
Ça c'est ton idée de départ mais ça ne me semble pas fameux tes classeurs qui se réinitalisent en début d'année parce que ça c'est en théorie... En théorie tout se passe bien mais comme tes classeurs sont toujours très complexe ben la théorie elle se fracasse...
Moi personnellement dans ce genre de situation je préfère et de loin des classeurs modèles vierges que je renouvelle chaque année. Mébon...
On va essayer de te le faire en théorie. !
Dans un module standard (Module1...) Tu mets en tête de module un :
Public YNewYear as BooleanComme tu n'y toucheras jamais cette variable sera donc toujours fausse.
Mais dans ta "Sub InitNouvelAn()" tu vas glisser cette ligne :
YNewYear = Trueensuite dans la macro KIVABIEN tu remplaces
.Cells(7, 4).FormulaR1C1 = "Fiche de non-conformité n° : " & Format(Now, "yyyy") & "_" & ipar :
.Cells(7, 4).FormulaR1C1 = "Fiche de non-conformité n° : " & Format(Now, "yyyy") & "_" & IIf(YNewYear, "001", i)Attention cette solution ne sera valable que tant que tu n'auras pas refermé ton classeur...
Cela suppose que très rapidement tu t'arranges pour que ton tableau soit vidé et que ta :
i = .Range("A" & Rows.Count).End(xlUp).Row + 1...renvoie le bon N° de ligne.
Parce que sinon à la prochaine réouverture du classeur ta variable (YNewYear) elle sera à nouveau False...
C'est bon ou je recommence ?
Sinon il y a surement quelque chose de plus simple : il suffirait que tu vides ton tableau avant de lire le N° de ligne pour que tout se passe bien. Mais pour l'instant, dans le marc de café c'est quand même un peu compliqué d'aller droit au but...
A+
Comme je suppose que ma solution ne te convient pas (parce que tu ne veut surement pas supprimer de ligne...)
Ya une autre possibilité : au lieu de te baser sur le n° de ligne tu vas te baser sur le dernier N° de fiche...
Ce N° tu l'enregistres dans une Nom du gestionnaire de nom :
ActiveWorkbook.Names.Add Name:="NoAno", RefersToR1C1:="=2018001"Ensuite le prochain N° sera:
[NoAno]+1et par suite :
.Cells(7, 4).FormulaR1C1 = "Fiche de non-conformité n° : " & [NoAno]+1ensuite enregistrer ce NouveauN° dans le Gestionnaire de nom
ActiveWorkbook.Names("NoAno").RefersTo =[NoAno]+1Bien entendu en début d'année prochaine dans la procédure "Sub InitNouvelAn()"
il faudra mettre :
ActiveWorkbook.Names("NoAno").RefersTo =2019001A+
Bonjour Galopin,
Merci de tes réponses, et à vu de nez la seconde me semble plus simple et plus astucieuse à mettre en œuvre, cependant je recherche une solution ou je n'ai pas à remodifier en début d'année la référence du compteur.
Penses tu qu'il soit possible de remplacer
ActiveWorkbook.Names.Add Name:="NoAno", RefersToR1C1:="=2018001"par quelques chose du style
ActiveWorkbook.Names.Add Name:="NoAno", RefersToR1C1:="="& Format(now, "yyyy") & "001"ou mon idée est complétement tordu ? j'ai bien peur que oui, ou avec un test du numero précedent on peut peut etre déterminer le changement d'année ?
Si tu d'autres idées je suis preneur.
Bonjour,
il te suffit de tester :
With ActiveWorkbook.Names("NoAno")
If Year(Date) > CLng(Left([NoAno], 4)) Then .RefersTo = clng(Year(Date) & "001") Else .RefersTo = [NoAno] + 1
End Witheric
T'es toujours aussi pénible ! Bientôt 500 à ton compteur et t'as pas encore compris qu'avec un bout de fichier on est plus pertinent :
J'ai envisagé la création d'un nom car on ne sait pas si tu est capable de récupérer le N° précédent dans une variable : Mais si tu es capable de comparer avec le N° précédent bien sur que tu n'as pas besoin de créer de nom.
Dans ce cas la procédures est très simple :
'...
NumeroPrécédent = ?????????
[code]If Year(Date) > CLng(Left(NumeroPrécédent, 4)) Then
.Cells(7, 4) = "Fiche de non-conformité n° : " & Year(Date) & "001"
Else
.Cells(7, 4) = NumeroPrécédent +1
End if[EDIT] En relisant un peu l'ensemble je réalise qu'il y a un petit problème :
Tes N° sont censés être des nombres sinon tu ne peux pas écrire : NumeroPrécédent +1
or dans ton code tu évoque un N° comme ça :
"Fiche de non-conformité n° : " & Format(Now, "yyyy") & "_" & ior ça, "2018_157" c'est un String et un String tu peux pas l'incrémenter...
Tu ne peux que le manipuler...
Je ne peux donc que te conseiller de virer ton string
J'en vois déjà rappliquer avec des commentaires salaces...
No comment hein !
A+
Merci eric,
Merci Galopin,
Je test cela dès que j'ai a nouveau le fichier sous la main.
Encore merci pour les explications et les solutions,
* j'ai rajouté un CLng dans le code des fois que....
Merci Eric,
Merci Galopin,
C'est parfait encore merci pour vos solutions et vos pistes de réflexions.
Je valide,
A très bientôt,