Sauvegarde d'un classeur Excel en VBA

Version imprimable

:yaisse2: Bonjour à tous :yaisse2:

Je suis en rade depuis quelques temps pour sauvegarder un classeur Excel avec une instruction VBA enregistrée dans "This WorkBook" !

Je désire sauvegarder mon classeur avec la valeur de deux cellules ainsi que la date du jour (voir code plus bas).

Avant que l'enregistrement se fasse, j'ai créé une instruction qui teste si les cellules sont remplies par l'utilisateur.

L'instruction est la suivante :

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("Remplacement").Range("B2") & (D5) = "" Then
       MsgBox "Saisir CASS ou Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
        If Sheets("Remplacement").Range("D3") = "" Then
        MsgBox "Saisir : Nom et Prénom      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
        End If
            If Sheets("Remplacement").Range("C5") = "" Then
            MsgBox "Saisir : Taux d'activité    ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
            End If
                If Sheets("Remplacement").Range("G6") = "" Then
                MsgBox "Saisir : Bureau            ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                End If
                    If Sheets("Remplacement").Range("B9") = "" Then
                    MsgBox "Saisir : Motif              ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                    End If
                        If Sheets("Remplacement").Range("B19") = "" Then
                        MsgBox "Saisir : Remplaçant(e)      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                        End If
                            If Sheets("Remplacement").Range("C20") = "" Then
                            MsgBox "Saisir : Mission Début      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                            End If
                                If Sheets("Remplacement").Range("G20") = "" Then
                                MsgBox "Saisir : Mission Fin        ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                End If
                                    If Sheets("Remplacement").Range("D21") = "" Then
                                    MsgBox "Saisir : Responsable d'Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                    End If
                                        If Sheets("Remplacement").Range("I21") = "" Then
                                        MsgBox "Saisir : Date Demande       ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                        Cancel = True
                                        End If
End Sub

Ce test fonctionne sans aucun problème mais voilà lorsque que je veux enregistrer le fichier Excel l'instruction suivante (mon problème) n'est pas prise en compte :

Code:

1
2
3
Private Sub SaveChoisir(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.SaveAs Sheets("Remplacement").Range("B2") & Format(Date, "yy\-mm\-dd").Value
End Sub

J'ai beau la mettre comme instruction séparée ou incluse dans le teste de validation après un "Else" compris entre "Cancel = True" et "End If"

J'ai fait de nombreuses recherches sur les divers forum et autres sites "spécialisés" dans Excel mais je n'ai rien trouvé d'efficace.

Les solutions trouvées approchaient celles que je mentionne mais sont soit pas prises en compte (comme la mienne) soit "plante" Excel au moment ou je procède à l'enregistrement.

Merci de votre aide.

Merci également d'être précis dans vos réponse car je débute en VBA.

Bonjour,

il lui manque quelques infos pour pouvoir sauvegarder le classeur
- le sauvegarder où ? (Chemin)
- sous quel format ? (.xls)
Code:

1 2 3 4 5 6 7 Dim Chemin As String, NomF As String Chemin = "D:\Sauvegarde\Fevrier\" '<-- à adapter NomF = Sheets("Remplacement").Range("B2") ActiveWorkbook.SaveAs Chemin & NomF & Format(Date, "yy\-mm\-dd") & ".xls"

Citation:
Envoyé par fring
Bonjour,

il lui manque quelques infos pour pouvoir sauvegarder le classeur
- le sauvegarder où ? (Chemin)
- sous quel format ? (.xls)
Code:

1 2 3 4 5 6 7 Dim Chemin As String, NomF As String Chemin = "D:\Sauvegarde\Fevrier\" '<-- à adapter NomF = Sheets("Remplacement").Range("B2") ActiveWorkbook.SaveAs Chemin & NomF & Format(Date, "yy\-mm\-dd") & ".xls"
Merci de ta réponse mais voilà cela ne fonctionne pas malgré que le code soit correct.

J'ai écrit dans "ThisWorkBook" après le code qui teste la validité des cellules, le code suivant :
Code:

1 2 3 4 5 6 7 8 Private Sub SaveChoisir(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Chemin As String, NomF As String Chemin = "S:\" '<-- à adapter NomF = Sheets("Remplacement").Range("B2") ActiveWorkbook.SaveAs Chemin & NomF & Format(Date, "yy\-mm\-dd") & ".xls" End Sub
Le code est-il mal placé ?

J'ai essayé uniquement ce code en supprimant le code de test sur la validité des cellules et ça ne fonctionne toujours pas !

Merci de votre aide à tous

21/02/2008, 18h42
Qwazerty

SAlut
Et depuis quand on peut mettre des caractère spéciaux dans les noms de fichier ? ;) (\?:/.....)
[Edit]Fring va me tuer quand il verra ce que j'ai dis a propos de son code ... :/... et en plus c'était une boulette... décidément c'est pas ma semaine :aie:[/Edit]

A++
Qwaz
22/02/2008, 08h15
olivepao

Citation:

Envoyé par Qwazerty

SAlut
Et depuis quand on peut mettre des caractere speciaux dans les noms de fichier ? ;) (\?:/.....)

A++
Qwaz

:bug: :bug:

Re-salut

Quels caractères spéciaux dans les nom du fichier . . . j'en vois aucun !

S:\ désigne uniquement le chemin de destination du fichier. Le fichier est nommé d'après les valeurs des cellules.

Je réintère ma demande, à savoir comment et où placé correctement le code.

Car malgré tous les essais et différentes infos trouvées sur le net, rien ne fonctionne.

Si quelqu'un désire peut m'aider efficassement, je peur lui envoyer mon tableau sur son mail. Pour tout contact olivepao AT bluewin DOT ch.

Merci

SAlut
Sauf erreur de ma part ton formatage de nom de fichier incorpore bien des "\" ? non ?

Code:

Format(Date, "yy\-mm\-dd")

Oupss la effectivement y'a erreur de ma part

Met ton fichier en ligne sur le forum ca sera effectivement plus efficace ;)

Apres reflection faudrait connaitre le contenu de la cellule avec laquelle tu nome le fichier
[Edit]
Faudrait vraiment voir le contenu de ta cellule, par ce que si je remplace le contenu de ta cellule par un mot quelconque ça fonctionne très bien[/Edit]

[Edit2]
Je viens de reprendre ton post du debut, et il faut faire attention tes indentation pretent a confusion. Ton code est le suivant

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("Remplacement").Range("B2") & (D5) = "" Then
       MsgBox "Saisir CASS ou Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
 
    If Sheets("Remplacement").Range("D3") = "" Then
    MsgBox "Saisir : Nom et Prénom      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("C5") = "" Then
    MsgBox "Saisir : Taux d'activité    ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("G6") = "" Then
    MsgBox "Saisir : Bureau            ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("B9") = "" Then
    MsgBox "Saisir : Motif              ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("B19") = "" Then
    MsgBox "Saisir : Remplaçant(e)      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("C20") = "" Then
    MsgBox "Saisir : Mission Début      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("G20") = "" Then
    MsgBox "Saisir : Mission Fin        ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("D21") = "" Then
    MsgBox "Saisir : Responsable d'Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("I21") = "" Then
    MsgBox "Saisir : Date Demande       ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    Cancel = True
    End If
 
End Sub

Le seul If qui est un effet (a part l'affichage de message) c'est le dernier, si tu veux ne pas executer ton code si un des if avant n'est pas vrai le code serait plutot

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("Remplacement").Range("B2") & (D5) = "" Then
       MsgBox "Saisir CASS ou Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
 
    If Sheets("Remplacement").Range("D3") = "" Then
        MsgBox "Saisir : Nom et Prénom      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
        If Sheets("Remplacement").Range("C5") = "" Then
            MsgBox "Saisir : Taux d'activité    ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
            If Sheets("Remplacement").Range("G6") = "" Then
                MsgBox "Saisir : Bureau            ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                If Sheets("Remplacement").Range("B9") = "" Then
                    MsgBox "Saisir : Motif              ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                    If Sheets("Remplacement").Range("B19") = "" Then
                        MsgBox "Saisir : Remplaçant(e)      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                        If Sheets("Remplacement").Range("C20") = "" Then
                            MsgBox "Saisir : Mission Début      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                            If Sheets("Remplacement").Range("G20") = "" Then
                                MsgBox "Saisir : Mission Fin        ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                If Sheets("Remplacement").Range("D21") = "" Then
                                    MsgBox "Saisir : Responsable d'Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                    If Sheets("Remplacement").Range("I21") = "" Then
                                        MsgBox "Saisir : Date Demande       ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                        Cancel = True
                                    Else
                                        'Ton enregistrement
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
 
End Sub

Ça évite d'avoir 50 msgbox a la suite si l'utilisateur a omis le remplissage de plusieurs cases en plus
[/Edit2]

A++
Qwaz

22/02/2008, 13h53
olivepao

:yaisse2: Merci Qwaz :yaisse2:

Je te poste mon fichier Excel (xlt) ziper !

De plus si tu as également une soluce pour les tests des champs "puces", il seront les bienvenus.

D'après ce que j'ai pu trouver dans mes bouquins et autres forums, c'est pô possible.

Merci également aux autres

Olive

Il n'y a que dans l'ombre que l'on y voit clair !

En ce moment le soleil frappe fort c'est certainement pour ça que je n'y voit pas grand chose !

A++++ tout le monde
22/02/2008, 19h31
Qwazerty
SAlut
Bon ton fichier et protegé, mais pour tes cases a cochés ou les radio bouton (je suppose que c'est ca les "puces", il te suffit d'utiliser leur propriete LinkedCel, comme son nom l'indique ca lie une cellule a ton check ou a ton radio, donc du coup la valeur de la cellule change en fonction de l'etat de ta chack/radio.

Sinon si tu ne souhaite pas les lier il te uffit de faire appele a eux tout simplement
Code:

1 2 If Remplacement.CheckBox1.Value then
D'ou l'interet de renomer les check/radio pour savoir a quoi ils correspondent ....
A++
Qwaz

Citation:

Envoyé par Qwazerty

SAlut
Sauf erreur de ma part ton formatage de nom de fichier incorpore bien des "\" ? non ?

Code:

Format(Date, "yy\-mm\-dd")

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("Remplacement").Range("B2") & (D5) = "" Then
       MsgBox "Saisir CASS ou Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
 
    If Sheets("Remplacement").Range("D3") = "" Then
    MsgBox "Saisir : Nom et Prénom      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("C5") = "" Then
    MsgBox "Saisir : Taux d'activité    ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("G6") = "" Then
    MsgBox "Saisir : Bureau            ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("B9") = "" Then
    MsgBox "Saisir : Motif              ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("B19") = "" Then
    MsgBox "Saisir : Remplaçant(e)      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("C20") = "" Then
    MsgBox "Saisir : Mission Début      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("G20") = "" Then
    MsgBox "Saisir : Mission Fin        ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("D21") = "" Then
    MsgBox "Saisir : Responsable d'Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
    If Sheets("Remplacement").Range("I21") = "" Then
    MsgBox "Saisir : Date Demande       ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    Cancel = True
    End If
 
End Sub

Le seul If qui est un effet (a part l'affichage de message) c'est le dernier, si tu veux ne pas executer ton code si un des if avant n'est pas vrai le code serait plutot

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("Remplacement").Range("B2") & (D5) = "" Then
       MsgBox "Saisir CASS ou Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
    End If
 
    If Sheets("Remplacement").Range("D3") = "" Then
        MsgBox "Saisir : Nom et Prénom      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
        If Sheets("Remplacement").Range("C5") = "" Then
            MsgBox "Saisir : Taux d'activité    ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
            If Sheets("Remplacement").Range("G6") = "" Then
                MsgBox "Saisir : Bureau            ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                If Sheets("Remplacement").Range("B9") = "" Then
                    MsgBox "Saisir : Motif              ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                    If Sheets("Remplacement").Range("B19") = "" Then
                        MsgBox "Saisir : Remplaçant(e)      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                        If Sheets("Remplacement").Range("C20") = "" Then
                            MsgBox "Saisir : Mission Début      ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                            If Sheets("Remplacement").Range("G20") = "" Then
                                MsgBox "Saisir : Mission Fin        ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                If Sheets("Remplacement").Range("D21") = "" Then
                                    MsgBox "Saisir : Responsable d'Unité", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                    If Sheets("Remplacement").Range("I21") = "" Then
                                        MsgBox "Saisir : Date Demande       ", vbExclamation, "          -  ERREUR DE SAISIE  -          "
                                        Cancel = True
                                    Else
                                        'Ton enregistrement
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
 
End Sub

Ça évite d'avoir 50 msgbox a la suite si l'utilisateur a omis le remplissage de plusieurs cases en plus
[/Edit2]

A++
Qwaz

Tu as "un peu" raison

Je dois tester toute les zones du formulaires qui ne sont pas remplies et ce qulques soit la zone qu'il manque. avec ton poste si une zone manque, le test est ok mai s'il manque tjs une zone non remplie, on sort du test. Ceci n'est pas ce que je désire. Je veux boucler dans le test tant que toutes les zones ne sont pas remplies.

Si tu as une soluce est la bienvenue. Merci

27/02/2008, 21h16
Qwazerty

SAlut
Comment veux tu boucler en permanence tes test, il faut bien que l'utilisateur est accès un moment ou a un autre pour faire la saisi de ce qui manque.
De plus en tant qu'utilisateur je pourrirais le développer d'un soft qui si j'oublie 20 champs, me colle 20 msgbox à la suite pour me dire de les remplir. enfin c'est toi qui vois, mais ton karma va en prendre un coup ... :D
Pour le faite que mon test soit ok, oui effectivement, mais si tu consultes l'aide en ligne tu vas apprendre des chose sur BeforSave et en particulier sur Cancel, qui te permet d'interdire l'enregistrement et donc de revenir a ton tableau excel sans avoir enregistré.
A++
Qwaz
28/02/2008, 11h14
olivepao

Citation:

Envoyé par Qwazerty

SAlut
Comment veux tu boucler en permanence tes test, il faut bien que l'utilisateur est accès un moment ou a un autre pour faire la saisi de ce qui manque.
De plus en tant qu'utilisateur je pourrirais le développer d'un soft qui si j'oublie 20 champs, me colle 20 msgbox à la suite pour me dire de les remplir. enfin c'est toi qui vois, mais ton karma va en prendre un coup ... :D
Pour le faite que mon test soit ok, oui effectivement, mais si tu consultes l'aide en ligne tu vas apprendre des chose sur BeforSave et en particulier sur Cancel, qui te permet d'interdire l'enregistrement et donc de revenir a ton tableau excel sans avoir enregistré.
A++
Qwaz

:roll: Salut :yaisse2:

Je veux simplement faire une boucle tant que tous les champs ne sont pas remplis. Si tous les champs sont remplis on sort bien entendu de la boucle.

Comme je suis un super débutant, existe-il une possibilité avec une intruction du type "do while . . ." avec ou sans if ? J'ai cherché dans le forum (et dans d'autres mais je n'ai rien trouvé)

J'ai simplifié le code et corrigé une erreur...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FL1 As Worksheet, TabloChamp As Variant, TabloMsg As Variant, i As Integer
Set FL1 = Worksheets("Remplacement")
    TabloChamp = Array("B2", "D3", "C5", "G6", "B9", "B19", "C20", "G20", "D21", "I21")
    TabloMsg = Array("CASS ou Unité", "Nom et Prénom      ", _
                     "Taux d'activité    ", "Bureau            ", "Motif              ", _
                     "Remplaçant(e)      ", "Mission Début      ", "Mission Fin        ", _
                     "Responsable d'Unité", "Date Demande       ")
    For i = 0 To UBound(TabloChamp) - 1
        If FL1.Range(TabloChamp(i)) = "" Then
            MsgBox "Saisir : " & TabloMsg, vbExclamation, "          -  ERREUR DE SAISIE  -          "
            Cancel = True
            Exit For
        End If
    Next
End Sub

J'avais deux fois "CASS ou Unité"
Tu vois ;)

28/02/2008, 13h30
olivepao
[:yaisse2: :aie:

J'ai testé mais ça plante sur :

Code:

MsgBox "Saisir : " & TabloMsg, vbExclamation, " - ERREUR DE SAISIE - "

dans le débogage de la macro. L'erreur est peut-être ailleurs ?

:aie: :bug:

Je plante tjs sur la récupération des cellules pour donner le nom au classeur lors de la sauvegarde
Code:

1 2 3 Private Sub SaveChoisir(ByVal SaveAsUI As Boolean, Cancel As Boolean) ThisWorkbook.SaveAs Sheets("Remplacement").Range("B2,D5") & Format(Date, "yy\-mm\-dd").Value End Sub
Cette macro a été récupérée dans un forum et fonctionnait . . . selon son auteur

A++++

Olive
28/02/2008, 14h28
ouskel'n'or

Oui, une autre faute de distraction :( , tu corriges

Code:

MsgBox "Saisir : " & TabloMsg(i), vbExclamation, " - ERREUR DE SAISIE - "

Ce qui me navre est que tu n'aies pas essayé de comprendre mon code, sinon tu aurais trouvé tout seul :cry:
A+ ;)
28/02/2008, 15h09
olivepao

:yaisse2::yaisse2::yaisse2::yaisse2:

Alors là :king: GENIAL :king: ça fonctionne jusqu'au dernier test en I21. Si I21 est vide malheureusement le test ne se fait pas !

J'ai ajouté un test "bidon" sur une cellule qui ne sert à rien et là ça fonctionne. C'est pas très élégant mais ça fonctionne. J'ai également essayé de voir s'il manquait une virgule ou un point mais là mes essais font tout foirer.

D'après toi y a t'il un risque de plantage sur cette cellule "bidon" ?

Maintenant je vais m'attaquer à ce même genrte de test pour des cellules qui comportent des cases à cocher et des boutons radio . . .

A+
28/02/2008, 16h50
ouskel'n'or

Citation:

Envoyé par olivepao

D'après toi y a t'il un risque de plantage sur cette cellule "bidon" ?

Non mais je ne comprends pas. Tu es sûr que tu n'as pas un espace dans la cellule I21 ?
Ubound donne le nombre d'éléments du tableau (soit 10) mais le premier élément est dans Tablo(0). C'est pourquoi je fais

Code:

For i = 0 to Ubound(Tablo) -1 ' => test sur les 10 éléments du tableau.

Alors je pas comprendre le pb, moi :cry:
Mais bon, si ça fonctionne avec ton bricollage... Regarde bien ce que ça fait, tout de même ;)
A+