Incrémenter le nom d'un fichier existant

Bonjour à tous,

Ma macro a pour objectif d'enregistrer le workbook actif. Sauf que si le nom existe déjà alors je souhaiterais l'incrémenter au fur et à mesure d'un suffixe.

Par exemple:

1/ Dans mon dossier "MonDossier", j'ai un classeur nommé "Hello".

2/ Je sauvegarde via ma macro mon classeur actif et le nomme "Hello".

3/ Ma macro le nommera "Hello_v1".

4/ Et ainsi de suite, si je sauvegarde de nouveau alors elle le nommera "Hello_v2".

J'ai réalisé une macro mais elle incrémente en prenant comme repère la longueur du nom du workbook, ce qui me pose problème.

Name= "Hello"
NameFile = "C:\MonDossier\" & Name & ".xlsm"

If Len(Dir(NameFile)) > 0 Then
    MsgExist = MsgBox("Un fichier nommé  " & NameFile & " existe déjà." & Chr(13) & "Souhaitez-vous le remplacer?", vbYesNoCancel + vbInformation, "Important")

    'Yes: Fichier est remplacé
    If MsgExist = vbYes Then
        ActiveWorkbook.SaveCopyAs Filename:=NameFile
        Else

    'No: Fichier est renommé en incrémentant un suffixe au nom du nouveau fichier
    If MsgExist = vbNo Then
        For i = 0 To Len(Dir(NameFile))
        NameFile = "C:\MonDossier\" & File & "_v" & i & ".xlsm"
        ActiveWorkbook.SaveCopyAs Filename:=NameFile
        Next
        Else

    'Cancel: Fichier ni remplacé, ni renommé
     If MsgExist = vbCancel Then
        MsgBox "L'enregistrement n'a pas pu aboutir.", vbExclamation
        End If
        End If
        End If

Else: ActiveWorkbook.SaveCopyAs Filename:=NameFile

End If

Pourriez-vous jeter un oeil sur ma macro et me dire ce que je dois changer pour qu'elle incrémente souhaitée, s'il vous plaît?

Merci d'avance pour votre aide.

Bonne fin de semaine.

Bonjour,

Ton incrémentation ne peut fonctionner car il boucle sur la longueur du nom de ton filename

et le nom de l'incrémentation non plus

Teste ceci

Comme tu travailles toujours sur la même feuille, à chaque enregistrement il va prendre la valeur de A1 (que j'ai mis au hazard) et qui s'incrémente à chaque nouvel enregistrement

Sub test()
Name = "Hello"
NameFile = ThisWorkbook.Path & Name & ".xlsm"

  If Len(Dir(NameFile)) > 0 Then
      MsgExist = MsgBox("Un fichier nommé  " & NameFile & " existe déjà." & Chr(13) & "Souhaitez-vous le remplacer?", vbYesNoCancel + vbInformation, "Important")
      'Yes: Fichier est remplacé
      If MsgExist = vbYes Then
          ActiveWorkbook.SaveCopyAs Filename:=NameFile
      Else
        'No: Fichier est renommé en incrémentant un suffixe au nom du nouveau fichier
        If MsgExist = vbNo Then
          i = i + ActiveSheet.Range("A1")
          NameFile = Name & "_v" & i & ".xlsm"
          ActiveWorkbook.SaveCopyAs Filename:=NameFile
          ActiveSheet.Range("A1") = ActiveSheet.Range("A1") + 1
        Else
          'Cancel: Fichier ni remplacé, ni renommé
          If MsgExist = vbCancel Then
            MsgBox "L'enregistrement n'a pas pu aboutir.", vbExclamation
          End If
        End If
      End If
  Else: ActiveWorkbook.SaveCopyAs Filename:=NameFile
  End If
End Sub

Bonjour @M12,

Je vous remercie pour votre aide.

J'ai essayé le code mais j'ai une erreur: "Run-time error '13': Type mismatch" et la ligne "i= i+ ActiveSheet.Range("A1")" est surligné.

Pourriez-vous m'éclairer afin de debugger la macro svp?

Merci par avance pour votre aide.

La ligne :

i = i + ActiveSheet.Range("A1")

--> i = 1 + ActiveSheet.Range("A1")

Bonjour @Xmenpl,

Malheuresement, ç ane fonctionne toujours pas, la même ligne est surligné en erreur.

Existe-il une autre alternative svp?

Merci d'avance pour votre aide.

Salut

essai ca ;

Sub test()

Name = "Hello"
NameFile = "D:\MonDossier\" & Name & ".xlsm"

If Len(Dir(NameFile)) > 0 Then
    MsgExist = MsgBox("Un fichier nommé  " & NameFile & " existe déjà." _
    & Chr(13) & "Souhaitez-vous le remplacer?", vbYesNoCancel + vbInformation, "Important")

    'Yes: Fichier est remplacé
    If MsgExist = vbYes Then
        ActiveWorkbook.SaveCopyAs Filename:=NameFile

    'No: Fichier est renommé en incrémentant un suffixe au nom du nouveau fichier
    ElseIf MsgExist = vbNo Then

        NameFile = "D:\MonDossier\" & Left((Dir(NameFile)), 5) & Val(Mid((Dir(NameFile)), 6))+1 & ".xlsm"
        ActiveWorkbook.SaveCopyAs Filename:=NameFile

    'Cancel: Fichier ni remplacé, ni renommé
     ElseIf MsgExist = vbCancel Then
        MsgBox "L'enregistrement n'a pas pu aboutir.", vbExclamation

     End If
Else

ActiveWorkbook.SaveCopyAs Filename:=NameFile
End If
End Sub

edit :NameFile = "D:\MonDossier\" & Left((Dir(NameFile)), 5) & Val(Mid((Dir(NameFile)), 6)) + 1 & ".xlsm"

Bonjour à tous, Bonjour @Amir

Super, votre solution a bien fonctionné Merci beaucoup pour votre aide!

J'ai une dernière question sur ce topic.

Est-il possible dans le cas où l'utilisateur clic sur CANCEL d'arrêter la macro, svp?

Autrement dit de cesser le run de la macro mais sans générer de bug.

Merci d'avance si vous pouvez m'aider sur ce détail.

Bonsoir à tous,

Un membre du forum pourrait m'éclairer au sujet de ma question:

Est-il possible dans le cas où l'utilisateur clic sur CANCEL d'arrêter la macro, svp?

Autrement dit de cesser le run de la macro mais sans générer de bug.

Lorsque je dis "Clic sur cancel", je parle du cancel généré par une message box avec pour option "vbYesNoCancel"

J'espère que ma question est claire.

Merci d'avance pour tous ceux qui pourront m'aider sur cette problématique.