Enregitrement qui boucle

O

olivepao

XLDnaute Occasionnel
Bonjour à tous du forum

Je rencontre un petit problème lorsque je sauvegarde mon formulaire au format xls depuis mon formulaire-modèle au format xlt.

Je n'arrive pas à comprendre pourquoi il fait une boucle au moment du save.

En effet l'enregistrement se fait en arrière plan, ce que je désire. Mais une fois sauvé, la combobox de sauvegarde s'ouvre, ce que je ne désire pas.

Merci à tous pour votre aide

Voici les 2 macros qui sont liées à l'enregistrement.


Je joins également le fichier zipé (j'ai enlevé toutes les fioritures de présentation pour qu'il fasse moins de 48,8 Ko)


Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' Macro exécutée à l'enregistrement du fichier

 MsgBox "Utilisateur " & Environ("username") + Chr$(13) + Chr$(13) _
                         & "Nous sommes le " & Date & " il est  " & Time & " " + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "La demande de remplacement va être enregistrée sur votre disque personnel." + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "Le fichier est enregistré sur le disque I:\DemandeTournants    " + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "il se nomme CASS-Nom du Collaborateur-Date du remplacement     " + Chr$(13) + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "Il ne vous reste plus qu'à lca faire parvenir par m@il au RU responsable du pool Tournants.        " + Chr$(13) + Chr$(13), _
                         vbOKOnly + vbExclamation, "                             -  LA DEMANDE EST REMPLIE CORRECTEMENT  -          "         ' <-- Mise en forme du message enregistrement

Dim Chemin As String, Lieu As String, NomAbs As String, m


Chemin = "C:\DemandeTournants"
Lieu = Sheets("Remplacement").Range("B3")       ' <-- Récupère la cellule B3 (Lieu de travail) de la feuille "Remplacement"
NomAbs = Sheets("Remplacement").Range("C5") ' <-- Récupère la cellule C5 (personne absente) de la feuille "Remplacement"
m = Month(Date)

CreationRepertoire Chemin

If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If


End Sub


Code: 
Sub CreationRepertoire(Chemin As String)                        ' <-- Macro liée à EnregistreClasseur
'
' Macro création du répertoire si ce dernier n'existe pô !
'
    If Dir(Chemin, vbDirectory + vbHidden) = "" Then  ' <-- Vérifie si le répertoire existe. S'il n'existe pas, il est créé.
    MkDir Chemin
    End If
                
End Sub
 

Pièces jointes

  • Fiche Remplaçant.zip
    20.2 KB · Affichages: 12
Trier par date Trier par votes
L

Larson

XLDnaute Junior
Re : Enregitrement qui boucle

Bonjour,

ton code de sauvegarde se trouve dans l'evenementielle 'BeforeSave'.
Ce qui se passe :
Tu demande l'enregistrement
La macro BeforeSave se declanche
Elle demande elle aussi un Save as
Donc, de nouveau BeforeSave se declanche
Qui demande de nouveau de faire un save as
Qui declanche de nouveau BeforeSave :eek:
ect
ect
...:eek:

Ben au moins le fichier il est sauvegardé :D !

Peut être en utilisant une variable Public qui serait à 0 lors de la demande d'enregistrement et qui passerai à 1 pour bloquer l'execution de l'evenementielle au moment des SaveAs ...
 
Vote positif 0 Vote négatif
O

olivepao

XLDnaute Occasionnel
Re : Enregitrement qui boucle

Larson à dit:
Bonjour,

ton code de sauvegarde se trouve dans l'evenementielle 'BeforeSave'.
Ce qui se passe :
Tu demande l'enregistrement
La macro BeforeSave se declanche
Elle demande elle aussi un Save as
Donc, de nouveau BeforeSave se declanche
Qui demande de nouveau de faire un save as
Qui declanche de nouveau BeforeSave :eek:
ect
ect
...:eek:

Ben au moins le fichier il est sauvegardé :D !

Peut être en utilisant une variable Public qui serait à 0 lors de la demande d'enregistrement et qui passerai à 1 pour bloquer l'execution de l'evenementielle au moment des SaveAs ...
Cliquez pour agrandir...


:) Merci de ta réponse

:eek: mais en langage clair VBA comment faire pour résoudre mon blème ? !
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Enregitrement qui boucle

Bonjour à tous,

Et en plus, le fichier n'est pas sauvegardé, puisque tout se passe Avant qu'il enregistre...

tu dois désactiver les évènements autour de tes 2 lignes qui enregistrent :

Code: 
[COLOR=red]Application.EnableEvents = False[/COLOR]
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
[COLOR=red]Application.EnableEvents = True
[/COLOR]
 
Vote positif 0 Vote négatif
O

olivepao

XLDnaute Occasionnel
Re : Enregitrement qui boucle

tototiti2008 à dit:
Bonjour à tous,

Et en plus, le fichier n'est pas sauvegardé, puisque tout se passe Avant qu'il enregistre...

tu dois désactiver les évènements autour de tes 2 lignes qui enregistrent :

Code: 
[COLOR=red]Application.EnableEvents = False[/COLOR]
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
[COLOR=red]Application.EnableEvents = True
[/COLOR]
Cliquez pour agrandir...

:) Merci tototiti2008, ta soluce me paraissait intéressante mais malheureusement cela ne fonctionne pas comme je le désire.

J'ai tjs la combobox de save qui s'ouvre après que le fichier se soit enregistré correctement.

Pour plus de précision, je veux que ma macro s'exécute totalement en arrière-plan lorsque je fais un clic sur l'une des icônes "enregistrement" ou "enregistrement sous" de la barre de d'outils ou du menu déroulant de "fichier".

:mad: Je continue de chercher une soluce dans le forum et autres sites consacré à Excel et VBA mais sans succès pour l'instant.
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Enregitrement qui boucle

Bonjour à tous,

pour intercepter le mécanisme d'enregistrement classique dans BeforeSave, tu dois mettre :
Cancel = True

ça devrait donner :

Code: 
[COLOR=#ff0000]Application.EnableEvents = False[/COLOR]
[COLOR=#ff0000]Cancel = true[/COLOR]
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
[COLOR=red]Application.EnableEvents = True
[/COLOR]
 
Vote positif 0 Vote négatif
O

olivepao

XLDnaute Occasionnel
Re : Enregitrement qui boucle

tototiti2008 à dit:
Bonjour à tous,

pour intercepter le mécanisme d'enregistrement classique dans BeforeSave, tu dois mettre :
Cancel = True

ça devrait donner :

Code: 
[COLOR=#ff0000]Application.EnableEvents = False[/COLOR]
[COLOR=#ff0000]Cancel = true[/COLOR]
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
[COLOR=red]Application.EnableEvents = True
[/COLOR]
Cliquez pour agrandir...

:) :) Merci tototiti2008
Le code fonctionne mais il plante lorsqu'il y a doublon.

En effet si ma sauvegarde porte déjà le nom d'un fichier enregistré, j'ai la traditionnelle combobox qui m'indique qu'un fichier portant le même nom existe déjà et me demande si je veux l'écraser.

Il y a trois possibilités OUI NON et ANNULE. si je réponds OUI pas de problème par contre si je répond NON ou ANNULE, je reçois une combobox

Erreur d'exécution 1004
La méthode 'SaveAs' de l'objet'_Workb a échoué

Le problème reste entier . . .

Par contre je suis entrain de tester (tout ne fonctionne pas encore) une macro qu'il faut mettre dans un module. Cette macro détourne la valeur de "enregistré" de la barre d'outils et du menu déroulant "fichier". Ca donne ceci :

With Application.CommandBars
.Item(1).FindControl(ID:=3, Recursive:=True).OnAction = "MaMacro"
.Item("Standard").FindControl(ID:=3, Recursive:=True).OnAction = "MaMacro"
End With

Les deux instuctions ci-dessous se rapporte à "Enregistrer".

Il me manque encore l'instruction pour "Enregistrer Sous".

Bien entendu il faut remettre la valeur initiale qui devrait se faire sous :

With Application.CommandBars
.Item(1).FindControl(ID:=3, Recursive:=True).OnAction = ""
.Item("Standard").FindControl(ID:=3, Recursive:=True).OnAction = ""
End With


Pour l'instant, je cherche . . .
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Enregitrement qui boucle

je te déconseilles les interceptions de boutons... tu ne pourra pas gérer tous les cas (comme le raccourcis Ctrl+S par exemple).

si le fichier existe déjà, tu veux l'écraser ou pas, ou tu veux la boîte de dialogue qui ne plante pas ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Dernière édition:
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Enregitrement qui boucle

une proposition qui ne devrait plus bugger :


Code: 
Application.EnableEvents = False
On Error Resume Next
Cancel = True
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
On Error GoTo 0
Application.EnableEvents = True
 
Vote positif 0 Vote négatif
O

olivepao

XLDnaute Occasionnel
Re : Enregitrement qui boucle

tototiti2008 à dit:
une proposition qui ne devrait plus bugger :


Code: 
Application.EnableEvents = False
On Error Resume Next
Cancel = True
If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If
On Error GoTo 0
Application.EnableEvents = True
Cliquez pour agrandir...


:) :) :) :)

Merci tototiti2008

J'ai fais 4 x le test et ça fontionne nickel. J'espère que je n'aurais pas de mauvaise surprises.

Merci également à Staple1600 pour ces deux renvois
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
XL 2021 Sauvegarde onglet
Réponses
10
Affichages
294
nano33320
N
P
  • Question
Microsoft 365 supprimer bouton lors de l'enregistrement
2
Réponses
28
Affichages
1 K
Staple1600
Staple1600
S
  • Résolu(e)
XL 2016 Séparateurs décimales & milliers sur un import csv
2
Réponses
18
Affichages
2 K
sabrina_
S
D
  • Question
XL 2019 vba : copier en valeur un onglet avant envoi par mail
Réponses
4
Affichages
867
douguy
D
C
  • Question
XL 2016 pièce jointe avec envoi mail VBA
Réponses
2
Affichages
1 K
CYRIL CAMPAS
C
gilles37
  • Question
XL 2019 Message en fonction d'une date
Réponses
11
Affichages
2 K
gilles37
gilles37
patricktoulon
  • Résolu(e)
XL 2013 compilation ZIP gestion d'attente
Réponses
5
Affichages
506
cp4
cp4
A
  • Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
557
aurelio.ewane
A
C
  • Résolu(e)
XL 2016 Séparer un classeur en plusieurs classeurs
Réponses
8
Affichages
764
soan
S
C
  • Question
Microsoft 365 enregistrer sous vba un classeur avec valeur cellule et non sur le lien
Réponses
3
Affichages
880
Chapichapo
C

Membres actuellement en ligne

2 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 595
Messages
2 090 093
Membres
104 374
dernier inscrit
cheick.coulibaly@dcsmali.