Discussion :

[korni184]

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

[Fvandermeulen]

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 :

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

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

[korni184]

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 :

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

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 !

[Fvandermeulen]

Salut,

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

Code :

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

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

[korni184]

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 :

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

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..

[Fvandermeulen]

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 :

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

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 :

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

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+

[korni184]

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 !

[Fvandermeulen]

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

j'ai corrigé par un Edit du post.

...
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 :

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

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 :

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

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

[korni184]

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...

[Fvandermeulen]

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 :

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
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+

[korni184]

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 ?

[Fvandermeulen]

Tu as deux possibilités:

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

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

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

[korni184]

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

[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 ?

[korni184]

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

[Fvandermeulen]

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 :

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

[korni184]

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 :

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
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..

[Fvandermeulen]

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 :

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

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 :

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