Incrémentation a la sauvegarde

Version imprimable

20/11/2012, 15h06
eliot.raymond

Incrémentation a la sauvegarde

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

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

Code:

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

20/11/2012, 19h34
patricktoulon

heu

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
21/11/2012, 11h41
eliot.raymond

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

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:

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

21/11/2012, 15h42
eliot.raymond

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
21/11/2012, 15h52
Oliv-

ajoute
dim FichierVersion
juste au dessus de FichierVersion =""
21/11/2012, 16h16
eliot.raymond

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

Code:

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
21/11/2012, 16h19
patricktoulon

heu

bonjour

tu pourrais preciser le type de variables

Code:

Dim FichierVersion, S_Ext as string , S_nom as string , StrName as string , PositionPoint as long
21/11/2012, 16h30
eliot.raymond

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 :whistle: :D

Merci pour ton intervention, c'est sympa

Cordialement Ray
21/11/2012, 16h37
eliot.raymond

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:

Merci également a patricktoulon

je clos le sujet

Bye bye

Cordialement Ray