Enregistrement auto lors de la fermeture de fichier

R

romainchu78

XLDnaute Occasionnel
Bonjour a tous, apres m'etre fait aide par des membres du forum je rencontre encore des petites diffultes avec la macro.
J'ai fais des test avec la macro dans un template. mais j'ai trouve des bugs que je ne sais pas repondre.
la macro s'active auto lorsque l'utilisateur ferme le fichier (fonction: BeforeClose). la macro
sert je le rappel a generer un nouveau fichier avec le nom indique en cellule C1 du template.

1) Lorsque la macro genere un nouveau fichier a partir du template, je voudrais qu'il ne copie pas le code du workbook du template dans le nouveau fichier genere.
2) Si le nouveau fichier existe deja dans le repertoire de destination, un message s'affiche: le fichier existe deja voulez vous le remplacer. si je click sur non, alors bizarrement un autre message s'affiche "le nom propose contient des caracteres interdits" meme si ce n'est pas le cas et en plus le fichier template ce ferme auto. je voudrais evite de voir apparaitre ce message apparaitre et qu'il ne ferme pas automatiquement le template.
3) Dans le cas ou l'utilisateur a ajouter un caractere interdit en cellule C1, apres le fichier template se ferme auto, je veux eviter cela. laissant a l'utilisateur la possiblite de renommer la cellule.

Merci de votre aide.
 

Pièces jointes

  • WORKSCOPE_Template Legacy 01-30-091_2.xls
    25 KB · Affichages: 140
Trier par date Trier par votes
B

bérylion

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

Salut

une proposition sur la base du code suivant :

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Nom As String
Nom = Range("C1") & ".xls"
If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
  SendKeys Nom
  Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
Else
  If Range("C1") = "" Then MsgBox "Enter the name of the file in the cell C1", 48: Range("C1").Select: Exit Sub
  'If MsgBox("The new file will be saved under the name " & Nom & " ?", 4) = 6 Then
    On Error Resume Next
    
    With ThisWorkbook
    
        .SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
        If Err Then MsgBox "le nom propose contient des caracteres interdits", 48: Range("C1").Select: Cancel = True: Exit Sub
  
        With .VBProject.VBComponents("ThisWorkbook").CodeModule
            .DeleteLines 1, .CountOfLines
        End With

  
   End With
  'End If
End If

End Sub

c'est fait à l'arrache, mais sur le principe ça efface la macro après enregistrement, et ça ne ferme pas le classeur si le nom est incorrect.

Enjoy...
;)
 

Pièces jointes

  • WORKSCOPE_Template Legacy 01-30-091_2_modif.xls
    35 KB · Affichages: 132
Vote positif 0 Vote négatif
R

romainchu78

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

merci beaucoup.
le point 1) ne fonctionne pas. j'ai toujours en copie le code dans le fichier destination.

le point 2) fonctionne partiellement: "Si le nouveau fichier existe deja dans le repertoire de destination, un message s'affiche: le fichier existe deja voulez vous le remplacer. si je click sur non, alors bizarrement un autre message s'affiche "le nom propose contient des caracteres interdits" meme si ce n'est pas le cas. je voudrais evite de voir apparaitre ce message apparaitre."

par contre effectivement le fichier ne se ferme plus automatiquement.

le point 3) fonctionne parfaitement.

peut- on m'aider a finaliser le code svp?
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Enregistrement auto lors de la fermeture de fichier

Bonjour,
Quand il est tard, vaut mieux aller se coucher (enfin pour moi)
Code: 
Private Sub Workbook_BeforeClose(cancel As Boolean)
Dim Rep As String, Fich1 As String, c As Byte, VBC As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Rep = ActiveWorkbook.Path & "\"
Fich1 = Sheets("WORKSCOPE").Range("C1") & ".xls"
    For c = 1 To Len(Fich1) 'test caractères interdits
        If InStr("\/:*?""""<>|", Mid(Fich1, c, 1)) > 0 Then
        MsgBox "Le nom en C1 contient des caractères interdits !"
        cancel = True
        Exit Sub
        End If
    Next
    If Dir(Rep & Fich1) <> "" Then 'test existence fichier
        MsgBox "Modifiez le nom en C1 car le fichier existe déjà !"
        cancel = True
        Exit Sub
    Else
    ActiveWorkbook.SaveAs Rep & Fich1
    End If
    With ActiveWorkbook.VBProject 'suppression code
        For Each VBC In .VBComponents
            If VBC.Type = 100 Then
                With VBC.CodeModule
                    .DeleteLines 1, .CountOfLines
                    .CodePane.Window.Close
                End With
            Else
                .VBComponents.Remove VBC
            End If
        Next VBC
    End With
    
SendKeys "%O" 'enregistrement

End Sub
A+
kjin
 
Dernière édition:
Vote positif 0 Vote négatif
B

bérylion

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

:confused:

bin, le point 2 j'avais zappé :D

sinon, chez moi ça fonctionne...

j'ai retaillé un peu le code en apportant une réponse à ton point 2 :

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Nom As String
Nom = Range("C1") & ".xls"
If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
  SendKeys Nom
  Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
Else
  If Range("C1") = "" Then MsgBox "Enter the name of the file in the cell C1", 48: Range("C1").Select: Exit Sub
  'If MsgBox("The new file will be saved under the name " & Nom & " ?", 4) = 6 Then
    On Error Resume Next
    
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(fso.BuildPath(ThisWorkbook.Path, Nom)) = True Then R = MsgBox("le fichier existe déja !" & Chr(13) & "Voulez vous le remplacer ?", 1)
If R = vbCancel Then Range("C1").Select: Cancel = True: Exit Sub
Application.DisplayAlerts = False
    
    With ThisWorkbook
    
        .SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
        If Err Then MsgBox "le nom propose contient des caracteres interdits", 48: Range("C1").Select: Cancel = True: Exit Sub
  
        With .VBProject.VBComponents("ThisWorkbook").CodeModule
            .DeleteLines 1, .CountOfLines
        End With
  
        .Save
  
   End With
  'End If
End If

End Sub

ça donne quoi ??
 

Pièces jointes

  • WORKSCOPE_Template Legacy 01-30-091_2_modif2.xls
    40.5 KB · Affichages: 105
Vote positif 0 Vote négatif
R

romainchu78

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

merci pour vos aides. le point 2 et 3 maintenant fonctionne grace au code de bérylion. par contre le point 1 ne fonctionne pas. kjin j'ai un message d'erreur a la ligne "With ActiveWorkbook.VBProject 'suppression code" sinon dans ton code kjin, je veux pouvoir ecraser une fichier existant et ne pas etre obliger de renommer avec un nouveau nom.
Si le code de bérylion fonctionnait avec le point 1 en plus cela serait parfait.
merci encore pour votre aide.
 
Vote positif 0 Vote négatif
B

bérylion

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

romainchu78 à dit:
merci pour vos aides. le point 2 et 3 maintenant fonctionne grace au code de bérylion. par contre le point 1 ne fonctionne pas. kjin j'ai un message d'erreur a la ligne "With ActiveWorkbook.VBProject 'suppression code" sinon dans ton code kjin, je veux pouvoir ecraser une fichier existant et ne pas etre obliger de renommer avec un nouveau nom.
Si le code de bérylion fonctionnait avec le point 1 en plus cela serait parfait.
merci encore pour votre aide.
Cliquez pour agrandir...

:confused:

et pourtant, elle tourne...

comme dirait l'autre !

y'a effectivement un "HIC", c'est que le classeur enregistré prétend contenir une macro :eek:

mais y'en a pas l'ombre de la queue d'une !!! :p

je creuse un peu pour voir si y'a pas moyen d'arranger ça.
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Enregistrement auto lors de la fermeture de fichier

Bonsoir,
bérylion: le couche tard c'est moi :)
Je n'ai aucun pb avec la ligne de code en question
J'ai un peu remanié le code pour la boite de message
Code: 
Private Sub Workbook_BeforeClose(cancel As Boolean)
Dim Rep As String, Fich1 As String, c As Byte, VBC As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Rep = ActiveWorkbook.Path & "\"
Fich1 = Sheets("WORKSCOPE").Range("C1") & ".xls"
    For c = 1 To Len(Fich1) 'test caractères interdits
        If InStr("\/:*?""""<>|", Mid(Fich1, c, 1)) > 0 Then
        MsgBox "Le nom en C1 contient des caractères interdits !"
        cancel = True
        Exit Sub
        End If
    Next
    If Dir(Rep & Fich1) <> "" Then 'test existence fichier
        Q = MsgBox(Fich1 & " existe déjà, voulez-vous le remplacer ?", vbYesNo)
        If Q = 7 Then GoTo Ligne1 Else GoTo Ligne2
    Else: GoTo Ligne2
    End If
    
Ligne1:
    cancel = True
    Exit Sub

Ligne2:
    ActiveWorkbook.SaveAs Rep & Fich1
        With ActiveWorkbook.VBProject 'suppression code
            For Each VBC In .VBComponents
                If VBC.Type = 100 Then
                    With VBC.CodeModule
                        .DeleteLines 1, .CountOfLines
                        .CodePane.Window.Close
                    End With
                Else
                    .VBComponents.Remove VBC
                End If
            Next VBC
        End With
    
SendKeys "%O" 'enregistrement

End Sub
A+
kjin
 

Pièces jointes

  • Romainchu.xls
    27.5 KB · Affichages: 128
Vote positif 0 Vote négatif
R

romainchu78

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

Kjin, j'ai exactement le meme probleme. le nouveau fichier se creer mais jai le message d'erreur suivant: 'run time error '1004' programmatic access to visual basic project is not trusted'
Et le debug pointe sur la ligne suivante: "With ActiveWorkbook.VBProject 'suppression code".
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Enregistrement auto lors de la fermeture de fichier

Bonsoir,
Quelle version Excel utilises tu ? il s'agit sans doute d'un pb de sécurité
A l'avenir, pour éviter ce genre de question et informer le lecteur, indique le dans ton profil pour le faire apparaitre
<--- ICI
A+
kjin
 
Vote positif 0 Vote négatif
B

bérylion

XLDnaute Occasionnel
Re : Enregistrement auto lors de la fermeture de fichier

kjin à dit:
Re,
A priori, la réponse est là
You may receive an run-time error when you programmatically allow access to a Visual Basic project in Excel 2003 and in Excel 2007
A+
kjin
Cliquez pour agrandir...

re-

oui, dès que l'on manipule du code par du code, il faut cocher "faire confiance au projet visual basic"

y'a moyen de "contourner" (enfin presque) en inscrivant la valeur directement dans le registre par VBA.
j'ai dit presque, parce que de cette manière il faut quitter et redémarrer excel pour que cette modif soit effective...
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Transfert données vers un fichier
Réponses
2
Affichages
141
lo-de
L
Tomasisco21
  • Question
Microsoft 365 Fichier automatisé VBA - Template Budget project
Réponses
5
Affichages
587
Tomasisco21
Tomasisco21
Y
  • Question
Microsoft 365 Couper une feuille d'Excel d'un dossier et l'a coller dans un autre fichier d'Excel
Réponses
1
Affichages
392
Hieu
H
S
  • Résolu(e)
Microsoft 365 En-tête et pied de page
Réponses
5
Affichages
288
Sissou71
S
P
  • Question
Autres Evenements VBA - Fermeture du classeur (Croix grise sur fond jaune) / fermeture de l'application (Croix rouge sur fond blanc)
Réponses
12
Affichages
511
papat0
P
M
  • Question
XL 2016 Excel UserForm VBA
Réponses
3
Affichages
295
patricktoulon
patricktoulon
M
  • Question
Microsoft 365 Garder les cases checkbox cocher lors de la fermeture d'un userform
2 3
Réponses
42
Affichages
1 K
mapomme
mapomme
M
  • Question
Microsoft 365 Tableau Bord via VBA
Réponses
13
Affichages
385
nat54
nat54
C
  • Question
Microsoft 365 Copier des données d'un fichier excel sur un fichier word
Réponses
0
Affichages
766
ChristianJ
C
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Message lors de modification de la cellule fusionnée
2
Réponses
15
Affichages
459
sylvanu
sylvanu

Membres actuellement en ligne

22 membres et 470 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 514
Messages
2 089 223
Membres
104 068
dernier inscrit
OLIVIER VERDIERE