XL 2013 Incrémenter indice du fichier lors de sa sauvegarde.

PIO.RORO · 4 Décembre 2021

Bonjour à tous

J'a besoin de votre aide!
Dans mon fichier, j'ai créé des onglets pour chaque métier. Une fois que le Métier concerné a rempli sa partie, il appui sur le bouton de SAVE pour sauvegarder ce qu'il a fait. Et donc créaton du fichier spécifique avec le nom du METIER correspondant.

Par contre, quand le METIER re-ouvre son fichier après l'avoir SAUVEGARDER, je voudrais un enregistrement par version 001, 002...D'où le bouton de SAVE VERSION...
Et là je bloque!!

Merci de votre soutien...

Slts
Pio

Robert · 4 Décembre 2021

Bonsoir le fil, bonsoir le forum,

Une autre proposition :

VB:

Public Sub CommandButton1_Click() 'SAVE ANNEXE
Dim chemin$, nom$, fichier$, FSE$, NSE$, SE$
Dim V As Integer, VM As Integer
SE = Split(ThisWorkbook.Name, ".")(0)
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" & Range("L4").Text & "_" & SE & "_V000.xlsm"
If InStr(1, ThisWorkbook.Name, "_V") = 0 Then
    REP = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
    ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
    ThisWorkbook.Close True
Else
    MsgBox "Ouvrez la dernière version xxx du fichier " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" &...

Robert · 4 Décembre 2021

Bonjour Pio, bonjour le forum,

Peut-être comme ça :

VB:

Public Sub CommandButton1_Click() 'SAVE ANNEXE
Dim chemin$, nom$, fichier$, FSE$, NSE$, SE$
Dim V As Integer, VM As Integer

With ThisWorkbook
    chemin = .Path & "\" 'dossier à adapter
    nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" & Range("L4").Text & "_" & .Name
    fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
    While fichier <> ""
        FSE = Split(fichier, ".")(0)
        NSE = Split(nom, ".")(0)
        If InStr(1, FSE, NSE, vbTextCompare) <> 0 Then
            MsgBox "Utilisez le bouton [Save Version] car il existe déjà une ou plusieurs versions de cette annexe !"
            Exit Sub
        End If
        fichier = Dir 'fichier suivant
    Wend
End With
SE = Split(ThisWorkbook.Name, ".")(0)
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" & Range("L4").Text & "_" & SE & "_V000.xlsm"
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
REP = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
End Sub


Private Sub CommandButton2_Click() 'SAVE VERSION
Dim chemin$, nom$, fichier$, FSE$, NSE$
Dim V As Integer, VM As Integer
Dim Test As Boolean

With ThisWorkbook
    chemin = .Path & "\" 'dossier à adapter
    nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" & Range("L4").Text & "_" & .Name
    fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
    While fichier <> ""
        FSE = Split(fichier, ".")(0)
        NSE = Split(nom, ".")(0)
        If InStr(1, FSE, NSE, vbTextCompare) <> 0 Then
            'On Error Resume Next
            V = CInt(Right(FSE, 3))
            If V >= VM Then VM = V
            Test = True
        End If
        fichier = Dir 'fichier suivant
    Wend
    If Test = True Then
        REP = MsgBox("Votre base de données est sauvegardée sous le nom : " & NSE & "_V" & Format(VM + 1, "000") & ".xlsm", vbYes + vbInformation, "Copie sauvegarde classeur")
        .SaveCopyAs ActiveWorkbook.Path & "\" & NSE & "_V" & Format(VM + 1, "000") & ".xlsm"
    Else
        MsgBox "Utilisez le bouton [Save Annexe] pour créer la première version !"
    End If
End With
End Sub

PIO.RORO · 4 Décembre 2021

Hello Robert,

D'abords un GRAND MERCI pour ce travail fait. Je suis à des années lumières....

Quand j'exécute la 1ºMACRO: SAVE ANNEXE PRODUIT. L'enregistrement se fait avec un index V000. Mais quand j'ouvre ce ficier V000 pour faire des modifications et les enregistrer en Version V001 cad 2ème MACRO, il vient alors le message que je dois d'abords executer la 1º MACRO.

L'dée de la VERSION est de partir du dernier document enregistrer
V000 incrémente en V001
V001 incrémente en V002
...
Merci de ton aide

Pio

Phil69970 · 4 Décembre 2021

Bonjour à tous

Juste en passant pourquoi ne pas se servir d'une cellule cachée par exemple la cellule A2 de feuille 2
(La cellule A1 est déjà prise)😉

Et de la séquence d'enregistrement

VB:

Dim Indice$
chemin = .Path & "\" 'dossier à adapter
racine = "PRODUIT" 'à adapter
Indice = " V" & Format(Feuil2.Range("A2"), "000")
'...... blablabla la suite du code
'Et avant le save as on rajoute 1 au nombre de la cellule A2
'cela permet d'être toujours prêt pour la prochaine sauvegarde

Feuil2.[A2].Value = Feuil2.[A2].Value + 1
.SaveAs chemin & racine & Indice

@Phil69970

PIO.RORO · 4 Décembre 2021

Bonsoir Phil69970,
Merci mais je n'y arrive pas. Quand j'ai essayé d'intégré le Code, cela me donne des erreurs. Où je ne sais pas comment faire! Je n'obtiens pas le même résultat
🙁
Slts
Pio

Robert · 4 Décembre 2021

Re,

Je m'en doutais un peu mais ce n'était pas très clair... Je regarde ça...

Robert · 4 Décembre 2021

Bonsoir le fil, bonsoir le forum,

Une autre proposition :

VB:

Public Sub CommandButton1_Click() 'SAVE ANNEXE
Dim chemin$, nom$, fichier$, FSE$, NSE$, SE$
Dim V As Integer, VM As Integer
SE = Split(ThisWorkbook.Name, ".")(0)
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" & Range("L4").Text & "_" & SE & "_V000.xlsm"
If InStr(1, ThisWorkbook.Name, "_V") = 0 Then
    REP = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
    ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
    ThisWorkbook.Close True
Else
    MsgBox "Ouvrez la dernière version xxx du fichier " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & "PRODUIT" & "_" _
       & Range("L4").Text & SE & "_Vxxx.xlms, puis utilisez le bouton [SAVE VERSION] pour créer les version suivantes !"
End If
End Sub


Private Sub CommandButton2_Click() 'SAVE VERSION
Dim chemin$, nom$, fichier$, FSE$, NSE$
Dim V As Integer, VM As Integer
Dim Test As Boolean

With ThisWorkbook
    chemin = .Path & "\" 'dossier à adapter
    fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
    While fichier <> ""
        FSE = Split(fichier, ".")(0)
        If InStr(1, FSE, "_V") <> 0 Then
            V = CInt(Right(FSE, 3))
            If V >= VM Then VM = V
            Test = True
        End If
        fichier = Dir 'fichier suivant
    Wend
    If Test = True Then
        NSE = Split(Sheets("ANNEXE PRODUIT").Range("B4").Text, ".")(0)
        NSE = Left(NSE, Len(NSE) - 3)
        REP = MsgBox("Votre base de données est sauvegardée sous le nom : " & NSE & Format(VM + 1, "000") & ".xlsm", vbYesNo + vbInformation, "Copie sauvegarde classeur")
        .SaveCopyAs .Path & "\" & NSE & Format(VM + 1, "000") & ".xlsm"
        .Close True
    Else
        MsgBox "Utiliser le bouton [SAVE ANNEXE] pour sauver la première version !"
    End If
End With
End Sub

PIO.RORO · 4 Décembre 2021

Bonsoir Robert & Phil69970,

Merci de votre support!

C'est bien cela!
Encore merci
Slts
Pio

PIO.RORO · 4 Décembre 2021

Bonsoir,

Je pourrais abuser de vos connaissances et vous pourriez me faire un code pour imprimer en PDF (Bouton nº3) ces 2 feuilles
"K0MV_EC 23703_TOYOTA_SUPPRESSIO" & "ANNEXE PRODUIT"

Je suppose que je devrais copier/coller ces codes dans chaque onglets du classeur!

Merci de votre support.
Slts
Pio

XL 2013 Incrémenter indice du fichier lors de sa sauvegarde.

PIO.RORO

XLDnaute Nouveau

Pièces jointes

Robert

Robert

XLDnaute Barbatruc

PIO.RORO

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

PIO.RORO

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

PIO.RORO

XLDnaute Nouveau

Merci de votre support!

PIO.RORO

XLDnaute Nouveau

Discussions similaires

XL 2013 Incrémenter indice du fichier lors de sa sauvegarde.

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

Merci de votre support!​

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency

Merci de votre support!