Discussion :

[Livio_14]

Bonjour à tous

Je souhaiterai pouvoir interdire à l'utilisateur d'enregistrer sur le C et mon code fonctionne pour cette partie et lorsque j'utilise le bouton Enregistrer.
Le probleme que je rencontre apparait lors d'un Enregistrer Sous : la fenetre de sauvegarde se rouvre plusieurs fois et il boucle dans la procédure Workbook_BeforeSave.
Je ne souhaite pas créer de bouton Enregistrer et laisser les fonctionnalités Enregistrer et Enregistrer Sous actives.

Merci pour votre aide !

Je joins le code ....

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
' SaveAsUI renvoie VRAI si la boîte de dialogue "Enregistrer Sous" va être affichée
' Cancel = True entraine l'impossibilité d'enregistrer
 
    Dim vCible As String, vSaveFile As Variant, vQuest As Integer
 
    'Bouton Enregistrer : Enregistrement du fichier sur son emplacement par défaut
    If SaveAsUI = False Then
        vCible = ThisWorkbook.Path
        If InStr(UCase(vCible), "C:\") = 1 Then
            MsgBox "Il est interdit de sauvegarder ce fichier sur votre disque dur", vbOKOnly + vbExclamation, "Enregistrement annulé"
            'Annule la demande d'enregistrement
            Cancel = True
            Exit Sub
        Else
            'Confirmation de l'ordre d'enregistrement
            Cancel = False
            Exit Sub
        End If
    'Bouton Enregistrer Sous : Enregistrement du fichier via boite de dialogue
    Else
        'Demande ou sauver le doc et le nom à lui donner
        vSaveFile = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excel workbooks (*.xlsm), *.xlsm", _
                    Title:="Please DO NOT SAVE this File on your Hard Drive")
        MsgBox vSaveFile
        'Si click sur Annuler, alors sortie
        If vSaveFile = False Then
            Cancel = True
            Exit Sub
        Else
            If InStr(UCase(vSaveFile), "C:\") = 1 Then
                MsgBox "Il est interdit de sauvegarder ce fichier sur votre disque dur", vbOKOnly + vbExclamation, "Enregistrement annulé"
                Cancel = True
                Exit Sub
            Else
                'Test d'existence du fichier
                'Existence
                If Dir(vSaveFile) <> "" Then
                    vQuest = MsgBox("Ce fichier existe déjà" & Chr(13) & "Voulez vous le remplacer ?", vbQuestion + vbYesNo, "Attention...")
                    ' Si oui, faut t-il l'effacer ?
                    'Confirmation
                    If vQuest = 6 Then
                        'Suppression et enregistrement
                        Application.DisplayAlerts = False
                        ThisWorkbook.SaveAs vSaveFile 'Sauvegarde
                        Application.DisplayAlerts = True
                    'Annulation
                    Else
                        Cancel = True
                        Exit Sub ' Stop procédure
                    End If
                'Nouveau fichier
                Else
                    ThisWorkbook.SaveAs vSaveFile 'Sauvegarde
                End If
            End If
        End If
    End If
 
End Sub

[jpvba]

Bonjour Livio,


Pouvez-vous mettre le code entre balise bouton # dans les outils lorsque vous écrivez votre texte ???

[unparia]

Bonjour

Cette procédure évènementielle se déclenche à chaque fois qu'est demandé une sauvegarde (Or, c'est bel et bien ce que tu fais à nouveau au sein-même de cet évènement).
Intéresse-toi à la propriété enableevents de l'objet application (rubrique Application.EnableEvents, propriété de ton aide VBA interne). Elle permet d'inhiber tous les évènements et donc d'éviter ton problème. Elle est ensuite à remettre à True lorsqu'il n'est plus nécessaire d'inhiber.
La rubrique en cause est assortie d'un exemple clair

NB : cette réponse ne signifie absolument pas que je "plussoie" le gymkhana que montre ton code. J'aurais personnellement procédé de manière moins tortionnaire ("chronologie" différente) , mais c'est là une autre affaire.

[Livio_14]

Merci unparia

Merci pour ton expertise. Je ressens pleinement tout le paradoxe de ma question, mais, en même temps, une fois vérifié que le nom du classeur est correct, il faut bien le sauver ! ;-)
Je vais me tourner avec espoir vers le Application.EnableEvents.

Grand merci pour ton analyse.

[Livio_14]

Bonsoir

Ca fonctionne ! Il faut effectivement jouer avec le Application.EnableEvents. Merci à Unparia !

Je vais débuguer un peu histoire de supprimer du code toutes les instructions inutiles et je le joindrai au dernier post.

[Livio_14]

Bonjour à tous

Eh non ! Finalement l'EnableEvents n'apporte rien ... mais ca m'a permis d'apprendre quelque chose ;-)

Ci dessous le code qui fonctionne et je joins le fichier

Bonne chance à tous

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
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
' SaveAsUI renvoie VRAI si la boîte de dialogue "Enregistrer Sous" va être affichée
' Cancel = True entraine l'impossibilité d'enregistrer
 
    Dim vCible As String, vSaveFile As Variant, vQuest As Integer
 
    'Bouton Enregistrer : Enregistrement du fichier sur son emplacement par défaut
    If SaveAsUI = False Then
        vCible = ThisWorkbook.Path
        If InStr(UCase(vCible), "C:\") = 1 Then
            MsgBox "Il est interdit de sauvegarder ce fichier sur votre disque dur", vbOKOnly + vbExclamation, "Enregistrement annulé"
            'Annule la demande d'enregistrement
            Cancel = True
            Exit Sub
        Else
            'Confirmation de l'ordre d'enregistrement
            Cancel = False
            Exit Sub
        End If
    'Bouton Enregistrer Sous : Enregistrement du fichier via boite de dialogue
    Else
        'Demande ou sauver le doc et le nom à lui donner
        vSaveFile = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excel workbooks (*.xlsm), *.xlsm", _
                    Title:="Please DO NOT SAVE this File on your Hard Drive")
        'MsgBox vSaveFile
        'Si click sur Annuler, alors sortie
        If vSaveFile = False Then
            Cancel = True
            Exit Sub
        Else
            If InStr(UCase(vSaveFile), "C:\") = 1 Then
                MsgBox "Il est interdit de sauvegarder ce fichier sur votre disque dur", vbOKOnly + vbExclamation, "Enregistrement annulé"
                Cancel = True
                Exit Sub
            Else
                'Test d'existence du fichier
                If Dir(vSaveFile) <> "" Then
                    vQuest = MsgBox("Ce fichier existe déjà" & Chr(13) & "Voulez vous le remplacer ?", vbQuestion + vbYesNo, "Attention...")
                    ' Si oui, faut t-il l'effacer ?
                    'Confirmation
                    If vQuest = 6 Then
                        'Suppression et enregistrement
                        Cancel = True
                        Application.DisplayAlerts = False
                        ThisWorkbook.SaveAs vSaveFile 'Sauvegarde
                        Application.DisplayAlerts = True
                    'Annulation
                    Else
                        Cancel = True
                        Exit Sub ' Stop procédure
                    End If
                'Nouveau fichier
                Else
                    Cancel = True
                    ThisWorkbook.SaveAs vSaveFile 'Sauvegarde
                End If
            End If
        End If
    End If
 
End Sub

[patricktoulon]

re
bonjour

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If SaveAsUI = False Then
        If Left(ThisWorkbook.Path, 3) = "C:\" Then Cancel = True: MsgBox "nan nan !!"
    Else
        Cancel = True
        vsavefile = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excel workbooks (*.xlsm), *.xlsm", Title:="Please DO NOT SAVE this File on your Hard Drive")
        If Left(CStr(vsavefile), 3) = "C:\" Then MsgBox "nan nan !!": Exit Sub
        ActiveWorkbook.SaveAs Filename:=vsavefile, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End If
End Sub