Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    Homme Profil pro
    Développeur informatique
    Inscrit en
    décembre 2018
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2018
    Messages : 4
    Points : 3
    Points
    3

    Par défaut Fonctionnement Workbook_BeforeSave vs ThisWorkbook.SaveAs

    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

  2. #2
    Membre actif
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    janvier 2017
    Messages
    444
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : janvier 2017
    Messages : 444
    Points : 266
    Points
    266

    Par défaut

    Bonjour Livio,


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

  3. #3
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    7 495
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 78
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 7 495
    Points : 13 018
    Points
    13 018

    Par défaut

    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.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...
    Les raisons réelles de délaissements ne sont pas toujours celles que l'on pense avoir déterminées.

  4. #4
    Candidat au Club
    Homme Profil pro
    Développeur informatique
    Inscrit en
    décembre 2018
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2018
    Messages : 4
    Points : 3
    Points
    3

    Par défaut

    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.

  5. #5
    Candidat au Club
    Homme Profil pro
    Développeur informatique
    Inscrit en
    décembre 2018
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2018
    Messages : 4
    Points : 3
    Points
    3

    Par défaut

    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.

  6. #6
    Candidat au Club
    Homme Profil pro
    Développeur informatique
    Inscrit en
    décembre 2018
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2018
    Messages : 4
    Points : 3
    Points
    3

    Par défaut

    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

  7. #7
    Débutant  
    Avatar de patricktoulon
    Homme Profil pro
    cuisiniste
    Inscrit en
    avril 2009
    Messages
    14 777
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 14 777
    Points : 22 452
    Points
    22 452
    Billets dans le blog
    6

    Par défaut re

    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. méthode SAVEAS qui ne fonctionne pas dans ACCESS/OUTLOOK
    Par emulamateur dans le forum VBA Access
    Réponses: 2
    Dernier message: 12/03/2015, 10h39
  2. [XL-2007] SaveAs htm - Excel cesse de fonctionner
    Par GymTonic dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 08/11/2013, 16h21
  3. [XL-2003] UnProtect ne fonctionne pas pendant ThisWorkbook.BeforeClose
    Par JYL74 dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 09/05/2011, 15h47
  4. [XL-2007] VBA - Saveas ne fonctionne pas ?
    Par jbs68 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 21/03/2011, 16h09
  5. Réponses: 10
    Dernier message: 17/02/2009, 15h51

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo