Discussion :

[olivepao]

Bonjour à tous

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 :

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

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

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.

[fring]

Bonjour,

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

Code :

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

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"

[olivepao]

Bonjour,

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

Code :

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

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 :

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

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

[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 [/Edit]

A++
Qwaz

[olivepao]

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

A++
Qwaz

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

[Qwazerty]

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

Code :

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

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 :

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

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