Incrémentation a la sauvegarde

**eliot.raymond** · 20/11/2012, 15h06

Bonjour a toutes et tous, Forum bonjour,

Je suis a la recherche d'un code VBA pour sauvegarder un fichier un peu spécialement.

Quand j'ouvre mon fichier baptiser "Finale classe 700.xlsm"

je souhaiterai svp que sur le bureau dans un dossier nommer par Ex: "Final"

Le fichier se sauvegarde a chaque fois que l'on quitte en cliquant sur la croix fermer du fichier en s'incrémentant automatiquement de 10 en 10.

Exemple:

Finale classe 700.xlsm
Finale classe 710.xlsm
Finale classe 720.xlsm

Qu'a chaque fois que je sauvegarde que celui-ci s'incrémente de 10 en 10 dans le dossier C:\Final\Finale classe 710.xlsm

Je ne sais pas si cela est possible ???

Merci a vous pour votre temps ainsi que de votre aide.

Bonne après-midi

Cordialement Ray

**Oliv-** · 20/11/2012, 15h52

Bonjour,
A utiliser dans l'événement Workbook_BeforeClose (ou Workbook_BeforeSave)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub test_versions()
    MsgBox strnameNew("toto-v1.0.xls", 1)
    MsgBox strnameNew(ThisWorkbook.Name, 1)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : strnameNew
' Author    : Oliv-
' Date      : 20/11/2012
' Purpose   : Incrémente un numéro de version
' exemple   : strnameNew("toto-v1.0.xls",1) devient "toto-v1.1.xls"
'---------------------------------------------------------------------------------------
'
Function strnameNew(NomClasseur As String, increm As Integer) As String
    s_Ext = Right(NomClasseur, Len(NomClasseur) - InStrRev(NomClasseur, ".") + 1)
    s_Nom = Left(NomClasseur, InStrRev(NomClasseur, ".") - 1)
    strName = StrReverse(s_Nom)
    positionPoint = InStr(1, strName, ".")
    FichierVersion = StrReverse(Left(strName, positionPoint - 1))
verif_version_numeric:
    If Not IsNumeric(FichierVersion) Then
        FichierVersion = InputBox("Veuillez corriger la version ACTUELLE" & vbCr & "en ne gardant que des nombres", "Texte non supporté", FichierVersion)
        GoTo verif_version_numeric
    End If
    strnameNew = StrReverse(Mid(strName, positionPoint, Len(strName) - positionPoint + 1)) & FichierVersion + 1 & s_Ext
End Function

**patricktoulon** · 20/11/2012, 19h34

bonsoir

en fait tout depend comment tu te sert de ce classeur
quand tu l'ouvre tu ouvre le dernier a chaque fois ?
ou esque que les classeur suvegardés sont des archives?

au plaisir

**eliot.raymond** · 21/11/2012, 11h41

Bonjour a tous et toutes, Forum bonjour

Merci de vos réponses c'est sympa a vous , je suis désolé pour ma réponse tardive, dû a un contretemps pour hier.

Merci oliv- et patricktoulon a plus tard et bonne journée

Je n'arrive pas a faire des essais, car je ne comprends pas trop comment procèder avec le code proposer

En fait je ne vois pas comment ca marche ni comment faire car je ne connais pas les fonctions

Encore du boulot pour moi au niveau VBA, mais j'y bosse.

Si svp tu a le temps et si tu veux bien, pourrai tu m'indiquer comment je dois mi prendre

Merci d'avance, une bonne journée

Cdlt

**Oliv-** · 21/11/2012, 14h34

Salut,
Comme cela avec une version différente de strnameNew si le nom n'est pas au format "xxxx .1.xls"

à coller dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strnameNew(ThisWorkbook.Name, 1), AddToMRU:=True
End Sub
 
 
'---------------------------------------------------------------------------------------
' Procedure : strnameNew
' Author    : Oliv-
' Date      : 20/11/2012
' Purpose   : Incrémente un numéro de version
' exemple   : strnameNew("toto-v1.0.xls",1) devient "toto-v1.1.xls"
'---------------------------------------------------------------------------------------
'
Function strnameNew(NomClasseur As String, increm As Integer) As String
    FichierVersion = ""
    On Error Resume Next
    s_Ext = Right(NomClasseur, Len(NomClasseur) - InStrRev(NomClasseur, ".") + 1)
    s_Nom = Left(NomClasseur, InStrRev(NomClasseur, ".") - 1)
    strName = StrReverse(s_Nom)
    positionPoint = InStr(1, strName, ".")
    If positionPoint Then
        FichierVersion = StrReverse(Left(strName, positionPoint - 1))
verif_version_numeric:
        If Not IsNumeric(FichierVersion) Then
            FichierVersion = InputBox("Veuillez corriger la version ACTUELLE" & vbCr & "en ne gardant que des nombres", "Texte non supporté", FichierVersion)
 
            GoTo verif_version_numeric
        End If
        strnameNew = StrReverse(Mid(strName, positionPoint, Len(strName) - positionPoint + 1)) & FichierVersion + 1 & s_Ext
 
    Else
        FichierVersion = "v0.1"
        strnameNew = s_Nom & FichierVersion & s_Ext
    End If
 
End Function

**eliot.raymond** · 21/11/2012, 15h42

Salut Oliv-

Merci pour ta réponse et le code modifier, c'est gentil a toi.

Avec en début de code Option Explicit

j'ai cette erreur ci-dessous et ca ne fonctionne pas

Variable non définie

FichierVersion=""

Par contre, si j'isole Option explicit , ca fonctionne

j'ai essayer de définir une variable mais j'ai toujours l'erreur

Une déclaration spéciale doit surement être a faire mais je ne vois pas laquelle

Merci, sinon ça doit être bon après

Cdlt

**Oliv-** · 21/11/2012, 15h52

ajoute
dim FichierVersion
juste au dessus de FichierVersion =""

**eliot.raymond** · 21/11/2012, 16h16

Merci, comme j'ai eu d'autres erreurs, j'ai déclarer comme ci-dessous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim FichierVersion, S_Ext, S_nom, StrName, PositionPoint

Je ne suis pas sur que ce soit bon, mais je n'ai plus d'erreur.

Cdlt

**patricktoulon** · 21/11/2012, 16h19

bonjour

tu pourrais preciser le type de variables

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim FichierVersion, S_Ext as string , S_nom as string , StrName as string , PositionPoint as long

**eliot.raymond** · 21/11/2012, 16h30

Salut patricktoulon

Merci pour la réponse, hé bien la en fait je ne savais pas trop, mais vu ton code je vais apporter la modification a mon programme.

je doute pas que c'est mieux ainsi

Merci pour ton intervention, c'est sympa

Cordialement Ray

**eliot.raymond** · 21/11/2012, 16h37

Salut Oliv-

C'est bon pour moi ça fonctionne bien comme je le souhaitai, je te remercie beaucoup pour ton aide car moi je n'aurai pas su faire.

Je te souhaite une bonne fin d'après midi avec encore un grand

Merci également a patricktoulon

je clos le sujet

Bye bye

Cordialement Ray

Incrémentation a la sauvegarde [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager