Enregistrement auto lors de la fermeture de fichier

romainchu78 · 30 Janvier 2009

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.

bérylion · 31 Janvier 2009

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

romainchu78 · 31 Janvier 2009

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?

kjin · 31 Janvier 2009

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

bérylion · 31 Janvier 2009

Re : Enregistrement auto lors de la fermeture de fichier

bin, le point 2 j'avais zappé

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

bérylion · 31 Janvier 2009

Re : Enregistrement auto lors de la fermeture de fichier

kjin à dit:
Bonjour,
Quand il est tard, vaut mieux aller se coucher (enfin pour moi)

A+
kjin

j'ai fait ça entre 2 couches et un bib' ...

Belle approche ton code ! (surtout à l'heure qu'il était )

romainchu78 · 2 Février 2009

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.

romainchu78 · 2 Février 2009

Re : Enregistrement auto lors de la fermeture de fichier

Bonjour a tous, personne ne peut m'aider sur ce dernier point? je ne sais pas comment faire.
merci pour votre aide.

bérylion · 2 Février 2009

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.

et pourtant, elle tourne...

comme dirait l'autre !

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

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

je creuse un peu pour voir si y'a pas moyen d'arranger ça.

kjin · 2 Février 2009

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

romainchu78 · 2 Février 2009

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

kjin · 2 Février 2009

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

romainchu78 · 2 Février 2009

Re : Enregistrement auto lors de la fermeture de fichier

J'ai microsoft office pro edition 2003 avec le SP3.
Est-ce un probleme de securite? pourtant le niveau de securite est au plus bas.

kjin · 2 Février 2009

Re : Enregistrement auto lors de la fermeture de fichier

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

bérylion · 2 Février 2009

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

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

Enregistrement auto lors de la fermeture de fichier

romainchu78

XLDnaute Occasionnel

Pièces jointes

bérylion

XLDnaute Occasionnel

Pièces jointes

romainchu78

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

bérylion

XLDnaute Occasionnel

Pièces jointes

bérylion

XLDnaute Occasionnel

romainchu78

XLDnaute Occasionnel

romainchu78

XLDnaute Occasionnel

bérylion

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

Pièces jointes

romainchu78

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

romainchu78

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

bérylion

XLDnaute Occasionnel

Discussions similaires