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

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #2

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 27 Octobre 2019

• #3

Bonsoir le fil

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

VB:

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?

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #4

Staple1600 à dit:

Bonsoir le fil

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

VB:

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?

Cliquez pour agrandir...

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

 

Vote positif 0 Vote négatif

D

decga

XLDnaute Nouveau

• 27 Octobre 2019

• #5

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

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #6

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #7

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

Claudy

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #8

re,
et pourquoi pas avant fermeture:

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

Claudy

 

Vote positif 0 Vote négatif

D

decga

XLDnaute Nouveau

• 27 Octobre 2019

• #9

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_"

VB:

'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"

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #10

Change H1 par A1

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #11

num = Range("A1").Value

 

Vote positif 0 Vote négatif

D

decga

XLDnaute Nouveau

• 27 Octobre 2019

• #12

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

 

Vote positif 0 Vote négatif

Claudy

XLDnaute Accro

• 27 Octobre 2019

• #13

Bin adapte alors à tes besoins!
A1 H1 ou AA650

A toi de voir

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 27 Octobre 2019

• #14

Bonjour decga, Claudy, JM,

decga à dit:

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

Cliquez pour agrandir...

Evidemment mais ça va servir à quoi ?

Voyez le fichier joint et cette macro :

VB:

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+

 

Pièces jointes

• Fichier000.xlsm

  17.2 KB · Affichages: 23

Dernière édition: 27 Octobre 2019

Vote positif 0 Vote négatif

D

decga

XLDnaute Nouveau

• 27 Octobre 2019

• #15

Claudy à dit:

Bin adapte alors à tes besoins!
A1 H1 ou AA650

A toi de voir

Cliquez pour agrandir...

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

VB:

'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"

 

Vote positif 0 Vote négatif