Discussion :

[korni184]

Bonjour,

j'ai crée une macro : sur le fichier 5 sheets,

Formulaire / travail / SLD&INT / DPT / DIVI / TITRES

J'ai créer un formulaire à remplir, avec 3 boutons "Production" "Sauvegarde" et "Nouveau"

Le problème est le language qui se trouve derière, le bouton sauvegarde.

J'arrive sauvegarder sans problème, mais je veux génerer un message d'erreur si les feuilles SLD&INT / DPT / DIVI sont vides.

un Message du genre : "Il n'y a rien a sauvegarder!"

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

Pour les codes ou il y a des ...... c'est normal, j'avais pas envie de tous recopier. Car internet et séparer de mon poste de travail.
Le message d'erreur se trouve sur la fonction "ISEMPTY".
Les trois pages ne doivent pas être forcement toutes remplies :

c'est à dire SLD&INT et DIVI peuvent avoir des données mais DPT non... donc il sauvegarde quand même. Le message d'erreur intervienderai seulement si les trois pages sont vierges.

Merci d'avance pour votre aide.

Bonne journée

[buzz73]

Bonjour,

1. Tu peux créer une collection si ton nombre de feuilles peut varier un jour
2. La fonction "FeuillesVides" retourne Oui/Non
3. Si la fonction retourne Oui => Message d'erreur sinon MessageOk

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
'***************
'Programme principal
'***************
Sub savecopy()
 
Dim MonMessErreur as string
Dim MonMessOk as string
Dim MsgBox_Titre as string
Dim col as new collection 'Une collection est une pile => tu mets autant de feuilles que tu veux dedans pour les vérifier
 
Dim LeNom As String
Dim LaLangue as string
Dim Lannee as string
 
Dim Sh_Form as worksheet 'Variable qui représentera la feuille Formulaire (plus simple à lire et à utiliser)
 
'**********************
'Renseignement des variables:
'**********************
'Message d'erreur
MonMessErreur = "Les documents sont vierges, donc il n'y a rien a sauvegarder"
'Message si Ok
MonMessOk ="Sauvegarde terminée"
'Titre de la boîte de dialogue
MsgBox_Titre="Traitement terminé"
 
'Collection des feuilles à vérifier
col.Add "travail "
col.Add "SLD&INT"
col.Add "DPT"
col.Add "DIVI"
col.Add "TITRES"
 
'Attribution de la feuille Formulaire dans la variable Sh_Form
Set Sh_Form=thisworkbook.sheets("Formulaire")
 
Lannee = Rigth(Sh_Form).Range("F21"),2)
LaLangue = Sh_Form.Range("F17")
LeNom =left(Sh_Form.Range("F15"),3) & "-" & right(Sh_Form.Range("F15"),3) & "_TOTAL_" & LaLangue & "_" & Lanee
 
 
'********
'Traitement
'********
'Feuilles vides?
If FeuillesVides(col)=True then
  'Message d'information
  MsgBox monMessErreur,vbOkOnly+vbExclamation,MsgBox_Titre
  Sh_Form.select
  Exit sub 'Sortie de la procédure car saisie incorrecte
else
  'Message d'information
  MsgBox MonMessOk ,vbOkOnly+vbInformation,MsgBox_Titre
end if 
 
'***************
'Suite du traitement
'***************
Sheets(Array("SLD&INT", "DPT", "DIVI")).COPY
 
CHDIR "K:.........."
ACTIVEWORKBOOK.SAVEAS FILENAME:="K.............." & LeNom & ".xls"
 
activeworkbook.close
 
end sub
 
 
'*******
'Fonction
'*******
Public Function FeuillesVides(ByVal col As Collection) As Boolean
    Dim NonVides As Boolean
    Dim Sh As Worksheet
    Dim AdresseZone As String
    Dim i As Integer
 
    'Initialisation de la variable
    NonVides = False 'On part du principe que les feuilles sont vides => On prend en compte la sauvegarde si NonVides=Vrai
    'Parcours des feuilles avec tests
    For i = 1 To col.Count
        Set Sh = Sheets(col.Item(i))
        'Test des constantes
        On Error Resume Next
        'Test si la feuille contient des constantes
        AdresseZone = Sh.Cells.SpecialCells(xlCellTypeConstants).Address
        On Error GoTo 0
        If AdresseZone <> "" Then
            NonVides = True
            Exit For
        End If
        'Test si la feuille contient des formules
        On Error Resume Next
        AdresseZone = Sh.Cells.SpecialCells(xlCellTypeFormulas).Address
        On Error GoTo 0
        If AdresseZone <> "" Then
            NonVides = True
            Exit For
        End If
    Next i
    On Error GoTo 0
 
    'Ce que retourne la fonction
    If NonVides Then
        FeuillesVides = False
    Else
        FeuillesVides = True
    End If
End Function

Et si tu as le cas de formules qui peuvent retourner "vide" dans les feuilles à tester alors on modifiera légèrement la fonction FeuillesVides sans toucher au reste du code.

[korni184]

Merci du coup de main,

bientôt je vais intégrer une nouvelle question pour une modification générale, dans une autre question.

J'esère que vous pourrez la voir -

Merci