Microsoft 365 Incrémenter le nom d'un fichier excel avec vba

[decga]

Bonjour,

Je suis actuellement à la recherche d'une solution pour incrémenter le nom d'un fichier

Alors en fait j'ai un fichier nommé "fichier000" dans lequel je rentre des informations qui sont envoyées dans 2 autres fichiers (jusque la je sais faire)
Ensuite j'aimerais fichier "fichier000" soit enregistré dans un autre dossier avec un nom différent du type "fichier001" et j'aimerais que le nom soit incrémenté à chaque fois que j'ouvre le fichier de base "fichier000"

Est ce que quelqu'un a la solution pour incrémenter le nom?


Code actuel pour l'enregistrement avec un nouveau nom :

'Enregistre la fiche EPM sous un nouveau nom
Workbooks("000 Trame EPM Info 2017-10-10").SaveAs "C:\Users\dgab\Desktop\EPM\EPM Test\ListeEPM\EPM0000000" & 1 & ".xlsm"


Merci d'avance

 

[Claudy]

Bonjour,
Perso, j'ai un fichier que j'enregistre à la fermeture comme ça:
Private Sub Workbook_BeforeClose(Cancel As Boolean)


ActiveWorkbook.Save
num = ActiveWorkbook.Name & "D " & Format(Date, "yymmdd") & " T " & Format(Time, "hhmmss")
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\claud\Google Drive\" & num & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Il sauvegarde à la date et heure minute seconde dans le dossier au choix

A toi de mettre exemple A1 un numéro à incrémenter et adapter le chemin.
A+

Claudy

 

[Staple1600]

Bonsoir le fil

Claudy
Pour info, tu peux simplifier pour obtenir une partie de ton num

Sub PourInfos()
MsgBox "D " & Format(Date, "yymmdd") & " T " & Format(Time, "hhmmss")
'Même résultat que ton code, mais en un peu plus court ;-)
MsgBox Format(Now, """D""yymmdd""T""hhmmss")
'Avec les espaces
MsgBox Format(Now, """D ""yymmdd"" T ""hhmmss")
End Sub

PS: Pourquoi tu n'utilises les balises BBCODE pour rendre le code VBA plus lisible dans tes messages?

 

[Claudy]

Bonsoir le fil

Claudy
Pour info, tu peux simplifier pour obtenir une partie de ton num

Sub PourInfos()
MsgBox "D " & Format(Date, "yymmdd") & " T " & Format(Time, "hhmmss")
'Même résultat que ton code, mais en un peu plus court ;-)
MsgBox Format(Now, """D""yymmdd""T""hhmmss")
'Avec les espaces
MsgBox Format(Now, """D ""yymmdd"" T ""hhmmss")
End Sub

PS: Pourquoi tu n'utilises les balises BBCODE pour rendre le code VBA plus lisible dans tes messages?

Hello,
ok merci
J'avoue que je découvre seulement cette icone!
Merci ,
Claudy

 

[decga]

Je ne comprend pas tout à ton code mais lorsque je le copie bêtement et que je l'adapte en changeant le chemin pour le dossier de sauvegarde il enregistre un des fichiers dans lequel les infos copier

Sinon est ce qu'il est possible que le nom du fichier qui va être enregistrer soit la valeur d'une cellule?

Merci d'avance

 

[Claudy]

 

[Claudy]

Bonsoir,
oui bien sur:
num = range("A1").value'exemple

Claudy

 

[Claudy]

re,
et pourquoi pas avant fermeture:

num = range("A1").value+1'exemple
comme ça ton fichier est automatiquement incrémenté

Claudy

 

[decga]

Je viens d'essayer ce que tu m'a dit mais ça ne fonctionne pas, ca ne prend pas en compte la valeur de la cellule A1 et donc le nom du fichier est juste "EPM_"

'Enregistre la fiche EPM sous un nouveau nom
num = Range("H1").Value
Workbooks("000 Trame EPM Info 2017-10-10").SaveAs "C:\Users\dgab\Desktop\EPM\EPM Test\ListeEPM\EPM_" & num & ".xlsm"

 

[Claudy]

Change H1 par A1

 

[Claudy]

num = Range("A1").Value

 

[decga]

Le H1 est juste l'adaptation de ton code au miens, j'ai rien dans la cellule A1

 

[Claudy]

Bin adapte alors à tes besoins!
A1 H1 ou AA650

A toi de voir

 

[job75]

Bonjour decga, Claudy, JM,

Sinon est ce qu'il est possible que le nom du fichier qui va être enregistrer soit la valeur d'une cellule?

Evidemment mais ça va servir à quoi ?

Voyez le fichier joint et cette macro :

Sub Enregistrer()
Dim chemin$, racine$, fichier$, maxi%
With ThisWorkbook
    chemin = .Path & "\" 'dossier à adapter
    racine = "Fichier" 'à adapter
    fichier = Dir(chemin & racine & "*.xlsm") '1er fichier du dossier
    While fichier <> ""
        If fichier Like racine & "###.xlsm" Then
            If Val(Mid(fichier, Len(racine) + 1)) > maxi Then maxi = Val(Mid(fichier, Len(racine) + 1))
        End If
        fichier = Dir 'fichier suivant
    Wend
    .SaveAs chemin & racine & Format(maxi + 1, "000") 'enregistrement avec incrémentation du nom
End With
End Sub

A+

 

[decga]

Bin adapte alors à tes besoins!
A1 H1 ou AA650

A toi de voir

Je viens de trouver l'erreur il fallait que je précise le classeur, la feuille et la cellule et pas juste la cellule

'Enregistre la fiche EPM sous un nouveau nom
num = Workbooks("000 Trame EPM Info 2017-10-10.xlsm").Worksheets("EPM_Info_template_FR").Range("H1")
Workbooks("000 Trame EPM Info 2017-10-10").SaveAs "C:\Users\dgab\Desktop\EPM\EPM Test\ListeEPM\EPM_" & num & ".xlsm"