Save as incrémenté

Bonjour a toutes et tous,

Voici mon soucis :

j'aimerais incrémenter en cas de révision la sauvegarde dans le répertoire d'origine en cas de modification. J'ai trouvé un morceau de code que j'ai essayé de placer dans mon fichier mais apparemment je ne suis pas très doué pour le VBA...

J'ai une partie du code dans un module nomé "Module 1"

' Répertoire de sauvegarde du PDF
Public Sub DefinitionCheminNomFichier(ByRef RepertoryPath$, ByRef FileName$)
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  Set Ws1 = Sheets("Information page")
  Set Ws2 = Sheets(Sheets("OPR info").Range("B4").Value)
  ' Sélectionne les 2 onglets définis ci-dessus
  Sheets(Array(Ws1.Name, Ws2.Name)).Select
  ' RepertoryPath = "C:\OPR request\" & Sheets("Information Page").Range("C13").Text & "\"
  RepertoryPath = "C:\Users\" & Environ("USERNAME") & "\Eurofiber Nederland BV\Design - Documents\17_Design\INFRABEL\OPR\" & Year(Now())
  ' Vérifier si chemin existe avec l'année, sinon le créer
  If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath
  ' Chemin définitif
  RepertoryPath = RepertoryPath & "\" & Sheets("Information Page").Range("C13").Text & "\"
  ' Vérifier si chemin existe, sinon le créer
  If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath
  ' Nom du fichier
  Dim i As Byte
  If FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text) = "" Then
     FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text)
  Else
    i = 2
    While FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text) & "_V" & i
    i = i + 1
    Wend
 End If

  ' On vérifie si "fileName" contient déja un "."
  If InStr(FileName, ".") = 0 Then
          FileName = FileName & ".pdf"
  Else
          FileName = Left(FileName, InStr(1, FileName, ".")) & "pdf"
  End If
End Sub

et une autre partie dans "Sub_additionnel"

' Répertoire de sauvegarde du PDF
Public Sub DefinitionCheminNomFichier(ByRef RepertoryPath$, ByRef FileName$)
  Dim Ws1 As Worksheet
  Dim Ws2 As Worksheet
  Set Ws1 = Sheets("Information page")
  Set Ws2 = Sheets(Sheets("OPR info").Range("B4").Value)
  ' Sélectionne les 2 onglets définis ci-dessus
  Sheets(Array(Ws1.Name, Ws2.Name)).Select
  ' RepertoryPath = "C:\OPR request\" & Sheets("Information Page").Range("C13").Text & "\"
  RepertoryPath = "C:\Users\" & Environ("USERNAME") & "\Eurofiber Nederland BV\Design - Documents\17_Design\INFRABEL\OPR\" & Year(Now())
  ' Vérifier si chemin existe avec l'année, sinon le créer
  If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath
  ' Chemin définitif
  RepertoryPath = RepertoryPath & "\" & Sheets("Information Page").Range("C13").Text & "\"
  ' Vérifier si chemin existe, sinon le créer
  If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath
  ' Nom du fichier
  Dim i As Byte
  If FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text) = "" Then
     FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text)
  Else
    i = 2
    While FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text) & "_V" & i
    i = i + 1
    Wend
 End If

  ' On vérifie si "fileName" contient déja un "."
  If InStr(FileName, ".") = 0 Then
          FileName = FileName & ".pdf"
  Else
          FileName = Left(FileName, InStr(1, FileName, ".")) & "pdf"
  End If
End Sub

Dans la seconde partie j'avais juste "FileName = "OPR_" & Func_additionnel.NettoyageNom(Sheets("Information Page").Range("C13").Text)" pour configurer le nom (donc après "'nom du fichier") et je me suis dis que j'allais placer le bout de code trouvé à cet endrois..... Mauvaise idée apparemment.....

Voici l'idée :

si le nom du fichier n'existe pas alors on le crée (le PDF + le save as de l'excel)

Si le nom du fichier existe on crée d'abord un "_v2" et on incrémente le cas échéants...

en écrivant ces ligne je me rend compte qu'il faudra aussi lier le bon fichier au mail automatique... Cela fera partie de la question bonus...

D'avance merci pour votre aide

Bonjour,

Pour ma part, lorsque des fichiers peuvent avoir plusieurs versions, leurs noms sont horodatés avec cette fonction :

Function GroupeDateHeure()

Dim DateDeCreation As Variant
Dim HeureEnCours As Variant

    DateDeCreation = Year(Date) & "-" & Format(Month(Date), "00") & "-" & Format(Day(Date), "00")
    HeureEnCours = Split(Time, ":")
    GroupeDateHeure = DateDeCreation & " " & Join(HeureEnCours, "-")

End Function

Sub TestGdh()

    MsgBox GroupeDateHeure

End Sub

Dans le répertoire de stockage, vos fichiers apparaîtront triés.

Bonjour Eric Kergresse,

Merci pour l'idée !!

J'ai légèrement adapté en applicant directement après le nom de ma sauvegarde sans passer par une nouvelle fonction, mais le principe reste le même.

J'ai ajouté le porceau de code ci-dessous après la définition de nom de fichier (pour le pdf et l'xlsm)

...... & "_" & Format(Date, "dd-mmmm-yyyy") & "_" & Format(Time, "hh-mm")