Macro de sauvegarde

Version imprimable

03/08/2010, 12h27
korni184

Macro de sauvegarde

Bonjour,

J'ai créer une macro permettant de créer un document.
J'ai créer en premier lieu un formulaire, ou l'on doit renseigner les champs.
Il y a ensuite 3 boutons : Un pour produire le document, un pour sauvegarder et un pour vider le formulaire.

Je rencontre un petit soucis pour sauvegarder le document.
Enfête je voudrais que lorsqu'on appuye sur sauvergarder,

un nouveau document excel se créer (et non pas une nouvelle sheet)
que je puisse copier 3 sheets de mon documents actuels dans l'autre documents et que je puisse l'enregistrer avec 3chiffres_3chiffres_totaux dans un chemin special sur un serveur.

exemple du nom : 999_999_totaux

J'espère que vous pourrez m'aider.

Merci d'avance

Salut,

A mon avis il sera plus simple d'utiliser le copier/coller de feuille.
Avec l'enregistreur de macros tu devrais pouvoir t'en sortir, ça devrait donner quelque chose du genre:
Code:

1 2 3 4 5 6 7 8 Sub SaveCopy() Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Copy ChDir "C:\TonChemin" ActiveWorkbook.SaveAs Filename:="C:\TonChemin\" & LeNom & ".xlsm" Activeworkbook.close End Sub
A toi de voir pour alimenter la variable LeNom avec les infos de ton exemple

Bug

Merci pour ta réponse, mais je rencontre à nouveau un problème :

j'ai créer un bouton pour déclencher cette macro :

dont le code est
Code:

1 2 3 4 5 6 7 sub savecorpy() sheets(Array("SLD&INT","DPT","DIVI")).COPY chdir "le chemin sans la barre" activeworkbook.saveas filename:="le chemin avec la barre à la fin" & LeNom & ".xlsm" activeworkbook.close end sub
et il bug sur la phrase avec le nom

Help !

Salut,

Si ton code (hormis les chemins) est complet, c'est normal !
Ta variable LeNom est vide, tu dois l'alimenter, donc...

Code:

1
2
3
4
5
6
7
8
9
10
11
sub savecorpy()
Dim LeNom as string
 
LeNom = sheets("PourLexemple").range("A1") 'Tu alimente ta variable, pour l'exemple avec le contenu de la cellule A1 de la feuille PourLexemple.
 
sheets(Array("SLD&INT","DPT","DIVI")).COPY
chdir "le chemin sans la barre"
activeworkbook.saveas filename:="le chemin avec la barre à la fin" & LeNom & ".xlsm"
activeworkbook.close
 
end sub

Solution

Ca fonctionne à présent, j'avais déterminer une variable dans un autre module, et il n'a pas suivit... ! à présent sa fonctionne !

Une dernière question, ma variable étant une série de chiffre 999999, je voudrais y intégrer un "-" pour obtenir 999-999. C'est possible ? sachant que je ne peux pas rajouter à la base ce tiret.

et je voudrais rajouter "_total_" et une autre variable après le dernier "_" pour rajouter la langue (deja déterminer dans un autre module)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub savecopy() Dim LeNom As String LeNom =Sheets("SLD&INT").Range("G3") Sheets(Array("SLD&INT", "DPT", "DIVI")).COPY CHDIR "K:..............." ACTIVEWORKBOOK.SAVEAS FILENAME:="K.............." & LeNom & ".xls" activeworkbook.close end sub
Pour le range("a3"), aucun problème car c'est le même chiffre qui apparait sur les 3 feuilles.

Merci d'avance..

Tu peux y arriver facilement avec le principe de concaténation (symbole &) comme pour le Filename du Save As.

En partant du principe que ta série comporte toujours 6 caractères, on va scinder en deux grâce à Left et Right pour ce qui est du mot Total, pas de soucis c'est du texte.
Pour la dernière partie, soit tu crées une nouvelle variable dans ce module (principe que je vais utiliser) soit tu déclares ton autre procédure en Public (tu devrais trouver un tuto expliquant ça sur le forum)

donc:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub savecopy() Dim LeNom As String, LaLangue as string LeNom =left(Sheets("SLD&INT").Range("G3"),3) & "-" & right(Sheets("SLD&INT").Range("G3"),3) LaLangue = 'Ici tu affecte la langue à la variable Sheets(Array("SLD&INT", "DPT", "DIVI")).COPY CHDIR "K:..............." ACTIVEWORKBOOK.SAVEAS FILENAME:="K.............." & LeNom & "_Total_" & LaLangue & ".xls" activeworkbook.close end sub
J'ai modifié à main levé j'espère ne pas avoir fait de faute de syntaxe...
On aurait pu aussi affecté à la variable LeNom la totalité de ce que tu souhaite:
Code:

1 2 3 4 LaLangue = 'Ici tu affecte la langue à la variable LeNom =left(Sheets("SLD&INT").Range("G3"),3) & "-" & right(Sheets("SLD&INT").Range("G3"),3) & "_Total_" & LaLangue ... ACTIVEWORKBOOK.SAVEAS FILENAME:="K.............." & LeNom & ".xls"
A+

04/08/2010, 14h24
korni184

Congratulation

Merci beaucoup !

C'était juste une "," et non pas un ";".

J'en ai appris beaucoup ! Je vous remercie !

Vous pensez que c'est possible aussi avec de "close" de la page d'envoyer la fonction "Print" et une fois que l'impression est lancer sur les 3 sheets que le fichier se ferme ? (sachant qu'on peut très bien fermer le document nous même..) c'est juste le lancement de l'impression qui pourrait être intéressant !
04/08/2010, 14h37
Fvandermeulen
Citation:

Envoyé par korni184

...
C'était juste une "," et non pas un ";".
...

:oops: j'ai corrigé par un Edit du post.

Citation:

Envoyé par korni184

...
Vous pensez que c'est possible aussi avec de "close" de la page d'envoyer la fonction "Print" et une fois que l'impression est lancer sur les 3 sheets que le fichier se ferme ? (sachant qu'on peut très bien fermer le document nous même..) c'est juste le lancement de l'impression qui pourrait être intéressant !

C'est possible, mais à ta place je mettrai une boite de dialogue pour confirmer (ou non) l'impression, sinon à chaque fermeture c'est l'impression, en ces temps Ecolo c'est pas top ;)

Pour une action avant fermeture, va sur Thisworkbook, double click et en choisisant Workbook au lieu de (Général) tu pourras accéder aux évènements dans la liste à droite.
Choisi Before close tu auras alors
Code:

1 2 3 4 Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub
tu n'as plus qu'à y insérer la procédure pour l'impression.
Si tu ne veux pas de validation la ligne suivante suffit

Code:

Sheets(Array("SLD&INT", "DPT", "DIVI")).printout
04/08/2010, 15h05
korni184

Finition

Super merci ! sa fonctionne à merveille,

j'aurai encore une question, mais je sais pas si je dois refaire une nouvelle question sur le forum juste pour ca : j'explique le problème :

Ma première sheet est un formulaire : une fois les données remplies on appuye sur un bouton "PRODUCTION" qui selectionne les données du formulaire une par une (sachant que se sont des variables) et il les utilises de la sheet travail, pour créer des tableaux, etc...

j'aimerai enfête créer des messages d'erreurs, imaginons que quelqu'un oublie la donnée à 6 chiffres (RefRacine) dans la cellule F15, ou qu'ils mettent que 5 chiffres. C'est possible de générer ces erreurs ?

Sanchant qu'il y a des données dans :

-les cellulles B10 à E13(que j'ai nommé adresse)

-F15 qui est un numéro de racine donc l'erreur (5 chiffres ou 7 chiffres ) sachant qu'il doit être à 6 chiffres, ou alors l'oublie

-F17 qui est la langue en deux lettres (majuscules minuscules, il le comprend déjà) donc juste l'oubli

-F19 est une série de 4 chiffres et rien de plus

-F21 est une année donc 2010 ou 2009 par exemple et pas plus.

Comment gérener tous ces messages d'erreur ?

exemple : Vous avez oublier l'année !

Si il en a oublier deux :

Vous avez oublier l'année !
Vous avez oublier l'adresse ! sur le même message d'erreur

Je sais que c'est surment long à expliquer, mais je retiens tous ces informations
et je vous en suis très reconnaissant...

Re,

Vu que ça n'a rien à voir, une nouvelle question aurait été mieux, toutefois, dans la feuille Excel tu peux déjà t'aider des validations de données, ça te permet déjà de forcer la saisie de certaine données, voir créer une liste comme pour l'année, en vba tu n'as plus qu'à vérifier si il y n'y a pas de saisie oubliée.

Sinon, tu peux à la validation, via VBA, pour chaque cellule, vérifier si le contenu est conforme. Mais tu dois alors être certain de tes algos et connaitre un peu la syntaxe
Par exemple,
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Verif() Dim MonMessErreur If Not IsNumeric(Range("F19")) Or Len(Range("f19")) <> 4 Then MonMessErreur = "La valeur saisie en F19 doit être numérique et de 4 caractères" & Chr(10) End If If IsEmpty(Range("F21")) Then MonMessErreur = MonMessErreur & "Vous avez oublier l'année" End If 'etc If MonMessErreur = "" Then MsgBox "Formulaire validé" 'Renvoyer vers l'autre procédure Else MsgBox MonMessErreur End If End Sub
A+

04/08/2010, 15h33
korni184

Question

D'accord mais ce code, je dois l'inserer ou enfin de compte ?

Car j'ai mon premier module qui comporte les variables avec la séléction de donnée et qui lance automatiquement suite à un bouton la construction des documents.
C'est à dire que je dois appuyer sur PRODUCTION pour lancer la macro, mais si je met Sub Verif, elle ne rentrera pas en action ? Le sub qui est accrocher sur le bouton est Macro2, je l'ai pas renommé.

Comment faire ?

Tu as deux possibilités:

1° tu ajoute le code au code existant avec une petite adaptation à mon exemple

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
 
Sub LeNomDeTaMacroActuelle ()
Dim MonMessErreur
 
If Not IsNumeric(Range("F19")) Or Len(Range("f19")) <> 4 Then
    MonMessErreur = "La valeur saisie en F19 doit être numérique et de 4 caractères" & Chr(10)
End If
 
If IsEmpty(Range("F21")) Then
    MonMessErreur = MonMessErreur & "Vous avez oublier l'année"
End If
 
'etc
 
If MonMessErreur <> "" Then
    MsgBox MonMessErreur
    Exit sub 'Sort de la procédure pour permettre la saisie correcte
Else
    MsgBox "Formulaire validé"
 End If  
 
'A partir d'ici la procdédure que tu as déjà...
 
End Sub

2° tu rattache cette macro au bouton et si saisie correcte tu appelles ton autre procédure (il suffit de mettre le nom de la macro), donc:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Verif()
Dim MonMessErreur
 
If Not IsNumeric(Range("F19")) Or Len(Range("f19")) <> 4 Then
    MonMessErreur = "La valeur saisie en F19 doit être numérique et de 4 caractères" & Chr(10)
End If
 
If IsEmpty(Range("F21")) Then
    MonMessErreur = MonMessErreur & "Vous avez oublier l'année"
End If
 
'etc
 
If MonMessErreur = "" Then
    MsgBox "Formulaire validé"
    LeNomDeTonAutreMacro 'pour renvoyer vers l'autre procédure
Else
    MsgBox MonMessErreur
End If
 
End Sub

04/08/2010, 15h48
korni184

Impeccable

D'accord sa fonctionne, le seul hic c'est qui balance quand même le programme, je voudrais le bloquer tant que les informations du formulaire ne sont pas valide.
En fin de compte qu'il se repositionne sur la sheet "formulaire", et qu'il continu pas dans le programme
04/08/2010, 15h51
Fvandermeulen

Pas normal, il y a un Exit sub qui doit "court-circuiter" la procédure, quelle solution as tu utilisé, peux tu mettre l'ensemble du code que tu as ?

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 
 
Public RacinRef As String
Public DatesDebutFin As String
 
Public Langue As String
Public DateDeCertific As String
 
Public PathResultat As String
Public DocumentResultat As String
 
Sub Macro2()
'Macro recorded 14/07/2010 by fd151
 
'**********
'MACRO TOTAUX
'**********
 
Dim MonMessErreur
 
If not isnumeric(range("F19)) or Len(range("f19)) <> 4 then
MonMessErreur1 = "La valeur saisie en F19 doit être numérique et de 4 caractères " & chr (10)
 
end if
 
'msg d'erreur pour la langue
if isempty(range("f17")) then
MonMessErreur2= "Vous avez oublier d'indiquer la langue"
 
end if
 
'msg d'erreur pour la l'année
if isempty(range("f21")) then
MonMessErreur = MonMessErreur1 & MonMessErreur2 & "Vous avez oublier l'année"
 
end if 
 
'msg d'erreur pour la l'adresse
if isempty(range("Adresse")) then
MonMessErreur = MonMessErreur & MonMessErreur2 & "Vous avez oublier l'adresse"
 
end if
 
if MonMessErrer = "" Then
MsgBox "Formulaire validé"
'Renvoyer vers l'autre procédure
 
else
msgbox MonMessErreur1 & MonMessErreur2
 
end if
 
Application.displayalerts= false
 
RacineRef= worksheets("Formulaire").Range("RacineRef").value
DatesDebutFin =Worksheets("Formulaire").Range("DatesDebutFin").value
 
Langue=Worksheets("formulaire").range("langue").value
 
DateDeCertific =  Worksheets("Formulaire").Range("DateDeCertific").value
 
'Caractéristiques du document contenant macro et templates
PathMacro = ActiveWorkbook.Path
DocumentMacro = ThisWorkbook.Name
 
'Locatisation du document source
Pathsource= "U:...............
 
'Sauvegarde du nom et de la date 
SourceCertific = Source & DateDeCertific
 
 
'''''''''''''''''''''''''''
'''EXECUTION DU 2EME MODULE
'''''''''''''''
'''''''''''''
'EXECUTION DU 3EME MODULE
'''''''''''''''''
'EXECUTION DU4EME MODULE
'''''''''''''''
 
SHEETS("FORMULAIRE").SELECT
 
END SUB

J'ai du recopier le module (car je suis au travail, et internet est indépendant du poste de travail). Donc y manque les parties excecution des modules. sinon tous est complet.

Vous pouvez m'aider pour les messages d'erreur ?
Je suis entrain de faire un massacre sur le haut...

Merci beaucoup

Il manquait le Exit Sub...j'ai corrigé pour le message d'erreur, l'idée est de compléter au fur et à mesure la variable MonMessErreur par concaténation.

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Public RacinRef As String
Public DatesDebutFin As String
 
Public Langue As String
Public DateDeCertific As String
 
Public PathResultat As String
Public DocumentResultat As String
 
Sub Macro2()
'Macro recorded 14/07/2010 by fd151
 
'**********
'MACRO TOTAUX
'**********
 
Dim MonMessErreur
 
If not isnumeric(range("F19)) or Len(range("f19)) <> 4 then
     MonMessErreur = "La valeur saisie en F19 doit être numérique et de 4 caractères " & chr (10)
end if
 
'msg d'erreur pour la langue
if isempty(range("f17")) then
     MonMessErreur= MonMessErreur & "Vous avez oublier d'indiquer la langue" & chr(10)
end if
 
'msg d'erreur pour la l'année
if isempty(range("f21")) then
     MonMessErreur = MonMessErreur & "Vous avez oublier l'année" & chr(10)
end if 
 
'msg d'erreur pour la l'adresse
if isempty(range("Adresse")) then
     MonMessErreur = MonMessErreur & "Vous avez oublier l'adresse" & chr(10)
end if
 
if MonMessErrer = "" Then
     MsgBox "Formulaire validé"
else
     msgbox MonMessErreur
     SHEETS("FORMULAIRE").SELECT
     Exit sub 'Sortie de la procédure car saisie incorrecte
end if
 
Application.displayalerts= false
 
RacineRef= worksheets("Formulaire").Range("RacineRef").value
DatesDebutFin =Worksheets("Formulaire").Range("DatesDebutFin").value
 
Langue=Worksheets("formulaire").range("langue").value
 
DateDeCertific =  Worksheets("Formulaire").Range("DateDeCertific").value
 
'Caractéristiques du document contenant macro et templates
PathMacro = ActiveWorkbook.Path
DocumentMacro = ThisWorkbook.Name
 
'Locatisation du document source
Pathsource= "U:...............
 
'Sauvegarde du nom et de la date 
SourceCertific = Source & DateDeCertific
 
 
'''''''''''''''''''''''''''
'''EXECUTION DU 2EME MODULE
'''''''''''''''
'''''''''''''
'EXECUTION DU 3EME MODULE
'''''''''''''''''
'EXECUTION DU4EME MODULE
'''''''''''''''
 
SHEETS("FORMULAIRE").SELECT
 
END SUB

D'accord sa fonctionne parfaitement,

Etant donnée que j'ai à présent deux boutons : l'un production et l'autre sauvegarde.

Est-il possible que je génère un message d'erreur pour la sauvegarde ?
C'est à dire que si il y a rien dans les feuilles "SLD&INT" "DPT" ET "DIVI". Il envoi un message d'erreur. "Document Vierge, il y a rien a sauvegarder".

Et si ce message est créer il n'y aura pas d'erreur si l'une des 3 feuilles est vide ??

Merci d'avance
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 37 Sub savecopy() Dim MonMessErreur 'Msg d'erreur si les documents sont vides If Isempty("Sheets("SLD&INT","DPT","DIVI")) then MonMessErreur = "Les documents sont vierges, donc il n'y a rien a sauvegarder" & chr (10) end if if MonMessErreur ="" Then Msg "Sauvegarde terminée else MsgBox MonMessErreur Sheets("Formulaire").select Exit sub 'Sortie de la procédure car saisie incorrecte end if Dim LeNom As String, LaLangue as string Lannee = Rigt(sheets "Formulaire").Range("F21"),2) LaLangue = Sheets("Formulaire").Range("F17") LeNom =left(Sheets("Formulaire").Range("F15"),3) & "-" & right(Sheets("Formulaire").Range("F15"),3) & "_TOTAL_" & LaLangue & "_" & Lanee Sheets(Array("SLD&INT", "DPT", "DIVI")).COPY CHDIR "K:.........." ACTIVEWORKBOOK.SAVEAS FILENAME:="K.............." & LeNom & ".xls" activeworkbook.close end sub
C'est le code que j'ai taper, mais il ne fonctionne pas... je voudrais dire que si les 3 documents sont vides, il empêche la sauvegarde..

Re,

Il y a de l'idée, malheureusement, Isempty ne fonctionne pas sur une feuille et quand tu utilise plusieurs feuille tu dois passer par Array

Code:

Sheets(Array("SLD&INT", "DPT", "DIVI"))

Mais il me semblait que les utilisateurs devaient faire une saisie, tu veux vérifier que la feuille soit complètement vide ou seulement certaines cellules?

Si c'est certaines cellules, inspires toi de du code existant avec les messages d'erreurs.

Si c'est la feuille entière (enfin les trois) qui doivent être vide, ce code fontionnera:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub SiWsVide() Dim Ws As Worksheet Dim tag As Byte For Each Ws In ThisWorkbook.Worksheets 'Boucle sur chaque feuille If Ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row = 1 Or Range("a1").SpecialCells(xlCellTypeLastCell).Column = 1 Then 'si la feuille est vide ligne et colonne équivalent à 1 tag = tag + 1 'Si vide on incrémente un Tag End If Next Ws If tag = 3 Then 'Si le tag vaut trois... MsgBox "les trois feuilles sont vides" ThisWorkbook.Close False 'Ferme le classeur actif sans sauver (grace à False) End If 'Le reste de la procédure End Sub