Numérotation auto + nom sauvegarde auto

droopeace · 13 Mai 2008

Bonjour à tous,

Je suis nouveau sur ce forum et j'ai un niveau, disons scolaire d'excel

Je souhaiterais créer un systême de numérotation automatique pour créer une référence de dossier, pour ensuite utiliser cette référence comme nom de sauvegarde et l'enregistrer dans un dossier spécifique précis, le tout automatiquement.

Je joins à ce message un fichier excel.

Je sais pas si je suis trés clair dans mes explications.

Merci d'avance de votre aide.

cbea · 13 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonjour droopeace,

Voici une solution.

Kotov · 13 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonjour Droopeace,

Insères le code suivant dans l'éditeur VBE (Alt+F11) dans le module ThisWorkbook

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cells(2, 5) = Cells(2, 5) + 1
For i = 1 To 5
    Sauv$ = Sauv$ & CStr(Format(Cells(2, i), "000"))
Next i
ThisWorkbook.SaveAs (Sauv$)
End Sub

A +
Kotov

Edit :
Désolé Cbea, je n'avais pas rafraîchi l'écran. Peut être avons nous une solution identique (Je vais regarder ta proposition).

Kotov · 13 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Re,

@ Cbea :

Nous avons eu des approches différentes pour un résultat quasi similaire :
La contrainte de ta proposition par bouton, c'est qu'en cas d'enregistrement par le bouton "Enregistrement officiel d'Excel" l'incrémentation ne s'effectue pas et le fichier est enregistré sous l'ancienne référence.

A l'inverse, avec la macro évènementielle Workbook_BeforeSave, la sauvegarde incrémentée est obligatoire à chaque enregistrement.

Avec ces 2 façons de procéder, Droopeace dispose d'un choix en fonction de ses besoins

Bonne soirée
Kotov

droopeace · 14 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Merci pour la rapidité de vos réponses, la proposition de Kotov a l'air de correspondre à mes attente mais je dois être une tache, car je n'arrive pas à l'adapter à mon fichier d'utilisation.

Donc si ce n'est pas top vous demander, je vous joins mon fichier d'utilisation.

Ah, j'oubliais de préciser, je souhaiterais que l'incrémentation de la référence se remette à 0 tous les 1 janvier.

J'espère ne pas trop abuser et être clair.

Merci d'avance.

cbea · 14 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonsoir à tous,

Voici une solution.

Kotov · 14 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonsoir Droopeace, Cbea,

Si la proposition de Cbea est nickel du point de vue informatique, il subsiste toutefois un problème d'ordre pratique :
En effet, le 1er janvier est ... férié, et, à moins de vendre des cachets d'aspirine, tu ne travailleras pas ce jour là, donc pas de facture.

Or, tu souhaites repartir à zéro chaque 1er janvier.
La macro proposée par Cbea correspond à ton souhait, mais ne réinitialisera les numéros de facture que si tu ouvres ton fichier ce jour là.
Si tu ne l'ouvres que le 2 janvier, la remise à zéro ne s'effectuera pas.

Aussi, j'ai modifié quelque peu ton fichier (comparaison du millésime + quelques modifs en rouge dans ton support) et je propose la macro suivante.
Pour tester le passage à l'année suivante, tapes 2007 dans la case K1 et logiquement la numérotation reprend à zéro si l'année en cours est d'un millésime supérieur.

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cells(1, 10) = Cells(1, 10) + 1
If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 0

For i = 5 To 9
    Sauv$ = Sauv$ & Cells(1, i)
Next i

Sauv$ = "C:\" & Sauv$ & "-" & CStr(Format(Cells(1, 10), "000")) & ".xls"
Cells(1, 11) = Year(Date)
ThisWorkbook.SaveCopyAs (Sauv$)

Application.DisplayAlerts = True
End Sub

Bonne soirée
Kotov

droopeace · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Tout d'abord, un GRAND MERCI pour votre aide, tout fonctionne, ou presque, car j'ai un petit problème lors de l'enregistrement AUTO, il me remet la cellule I1 (qui est avec la Formule =si(C5="";"";maintenant()) et au format Date aaaa-mm sur excel) au format jj/mm/aaaa hh:mm:ss, et donc il me met un message d'erreur concernant les caractères / qui ne sont pas admis pour un nom d'enregistrement.

Je soushaiterais qu'ils restent au format "aaaa-mm-".

Je vous remets le code Visual Basic que j'utilise :

-------------------------------------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cells(1, 10) = Cells(1, 10) + 1
If Cells(1, 9) > Cells(1, 11) Then Cells(1, 10) = 1

For i = 5 To 9
Sauv$ = Sauv$ & Cells(1, i)
Next i

Sauv$ = "C:\" & Sauv$ & "-" & CStr(Format(Cells(1, 10), "000")) & ".xls"
Cells(1, 11) = Year(Date)

ThisWorkbook.SaveCopyAs (Sauv$)

Application.DisplayAlerts = False

End Sub
-------------------------------------------------------------------------------

Encore merci d'avance de votre aide.

tototiti2008 · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonjour à tous,

Je te propose :

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cells(1, 10) = Cells(1, 10) + 1
If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 0

For i = 5 To 8
    Sauv$ = Sauv$ & Cells(1, i)
Next i

Sauv$ = Sauv$ & format(cells(1,9),"yyyy-mm")

Sauv$ = "C:\" & Sauv$ & "-" & CStr(Format(Cells(1, 10), "000")) & ".xls"
Cells(1, 11) = Year(Date)
ThisWorkbook.SaveCopyAs (Sauv$)

Application.DisplayAlerts = True
End Sub

cbea · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonjour droopeace, kotov,

Effectivement, ma solution n'était pas pratique.
La méthode se trouvait dans ma précédente réponse.

Voici une solution.

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.DisplayAlerts = False
    
    Cells(1, 10) = Cells(1, 10) + 1
    
    If Cells(1, 9) > Cells(1, 11) Then Cells(1, 10) = 1

[COLOR="Red"]    For i = 1 To 6
        Select Case i
            Case Is <= 4
                Sauv$ = Sauv$ & Cells(1, 4 + i).Value
                
            Case 5
                Sauv$ = Sauv$ & Format(Cells(1, 4 + i).Value, "yyyy-mm-")
    
            Case 6
                Sauv$ = Sauv$ & Format(Cells(1, 4 + i), "000")
        End Select
    Next i[/COLOR]    

    Cells(1, 11) = Year(Date)
    ThisWorkbook.SaveCopyAs (Sauv$)
    
    Application.DisplayAlerts = False
End Sub

PS : Bonjour tototiti2008, excuse-moi, je n'avais pas vu ta réponse

droopeace · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cells(1, 10) = Cells(1, 10) + 1
[COLOR="Red"] If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 0[/COLOR]  

For i = 5 To 8
    Sauv$ = Sauv$ & Cells(1, i)
Next i

Sauv$ = Sauv$ & format(cells(1,9),"yyyy-mm")

Sauv$ = "C:\" & Sauv$ & "-" & CStr(Format(Cells(1, 10), "000")) & ".xls"
Cells(1, 11) = Year(Date)
ThisWorkbook.SaveCopyAs (Sauv$)

Application.DisplayAlerts = True
End Sub

RE-bonjour,

Pouvez vous me traduire la ligne :
If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 0

Car la fonction de remise à 0 au changement d'année ne fonctionne pas ???

Merci de vos lumières.

tototiti2008 · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Euh... à vrai dire je sais pas, j'ai volé le code à Kotov.
Comme j'ai pris la discussion en cours, je me suis contenté d'apporter un réponse à la dernière quesion : mettre la date au format AAAA-MM

Je suppose que Kotov a tapé en K1 :
1/1/2009
et en K2
=aujourdhui()

Le mieux serait peut-être de mettre :

Code:

If Cells(2, 11) > Cells(1, 11) Then 
Cells(1, 10) = 0  
Cells(1,11) = cdate("1/1/" & year(Date))
end if

Kotov · 15 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

Bonjour à tous,

En K1 : aucune formule. C'est dans cette cellule qu'à chaque sauvegarde, la macro mémorise le millésime de l'année qui servira de base à la comparaison lors de la sauvegarde suivante --> Cells(1, 11) = Year(Date)

En K2 : =ANNEE(AUJOURDHUI()) --> à chaque sauvegarde cette cellule affiche le millésime actuel

Ainsi en comparant K1 et K2, je détecte le changement millésime :
If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 0
Si K2 > K1, le n° de facture repasse à zéro. Dans le cas contraire, le n° de facture est incrémenté d'une valeur.
L'avantage, c'est qu'il n'est pas nécessaire d'ouvrir le fichier le 1er janvier pour la remise à zéro

Ex : Droopeace réalise sa dernière facture le 31/12/2007 : K1 = 2007 ; K2 = 2007 donc le numéro de facture est incrémenté de +1
Il prend ensuite un mois de vacances et prépare sa facture suivante le 2 février 2008 : à l'ouverture du fichier K1 = 2007 tandis que K2 =2008. En conséquence, le n° de facture repasse à zéro, K1 devient 2008 et K2 reste 2008, permettant les incrémentations suivantes tout au long de l'année.

----
Dans ma proposition, j'ai également modifié la cellule I1 du fichier original

I1 : =SI(E1="";"";K2 &"-"& K3)
sachant que K2 : =ANNEE(AUJOURDHUI()) et K3 : = MOIS(AUJOURDHUI())

Je préfère concaténer le millésime et le mois sous la forme d'une chaîne (String) plutôt qu'utiliser la fonction =Maintenant() qui reste sous une forme numérique avec virgule pour les heures (dont on a pas besoin et qui te pertubent dans ton format) : l'usage final restant bien entendu de réaliser un nom de fichier sous la forme d'une chaîne.

En espérant avoir répondu à vos questions.

Bonne journée
Kotov

droopeace · 16 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

SUPER SUPER NICKEL, vous êtes trop fort.

Derniers questions :

* lorsque je protége les Cellules J1 et K1, j'ai un message d'erreur ???
* Je souhaiterais, qu'une fois que l'on enregistre une Feuille, que toutes les cellules se vérouillent complétement, c'est à dire que la Feuille soit modifiable UNIQUEMENT en tapant un mot de passe.

Est ce possible, si oui, pouvez vous me compléter mon Code.

MERCI D'AVANCE.

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.DisplayAlerts = False
        Cells(1, 10) = Cells(1, 10) + 1
        If Cells(2, 11) > Cells(1, 11) Then Cells(1, 10) = 1
        
    For i = 5 To 8
        Sauv$ = Sauv$ & Cells(1, i)
    Next i

        Sauv$ = Sauv$ & Format(Cells(1, 9), "yyyy-mm")

        Sauv$ = "c:\" & Sauv$ & "-" & CStr(Format(Cells(1, 10), "000")) & ".xls"
        Cells(1, 11) = Year(Date)
    ThisWorkbook.SaveCopyAs (Sauv$)

    Application.DisplayAlerts = True
End Sub
[\CODE]

Pierwak · 16 Mai 2008

Re : Numérotation auto + nom sauvegarde auto

sheets("nom_de_la_feuill_a_protéger").protect Password:="0000" al afin de ton code... tu mets le mdp que tu veux.
mais n'oublie pas de mettre des:
sheets("nom_de_la_feuill_a_protéger").unprotect Password:="0000" au début de toutes tes méthodes qui doivent écrire dans la feuille.

Numérotation auto + nom sauvegarde auto

droopeace

XLDnaute Nouveau

Pièces jointes

cbea

XLDnaute Impliqué

Pièces jointes

Kotov

XLDnaute Impliqué

Kotov

XLDnaute Impliqué

droopeace

XLDnaute Nouveau

Pièces jointes

cbea

XLDnaute Impliqué

Pièces jointes

Kotov

XLDnaute Impliqué

Pièces jointes

droopeace

XLDnaute Nouveau

tototiti2008

XLDnaute Barbatruc

cbea

XLDnaute Impliqué

droopeace

XLDnaute Nouveau

tototiti2008

XLDnaute Barbatruc

Kotov

XLDnaute Impliqué

droopeace

XLDnaute Nouveau

Pierwak

XLDnaute Occasionnel

Discussions similaires