Bug a la fermeture d'un classeur

[sev]

Bon week end à tous ,

Lorsque je ferme un classeur sans vouloir le sauvegarder sur le disque dur et clé USB , j'ai un Bug.
Comment éviter cela ?
Voici le code de fermeture :

Private Sub Workbook_BeforeClose(Cancel As Boolean)

      
   ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\SEV\Documents\comptes\agenda.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
    
 If MsgBox("Voulez vous enregistrer les modifications sur une clé USB ?", vbQuestion + vbYesNo, "ENREGITRE LES MODIFICATIONS") = vbNo Then Exit Sub
 MsgBox "Attention insérer une clé USB pour la sauvegarde ", vbInformation + vbOK
       ChDir "H:\"
   ActiveWorkbook.SaveAs Filename:="H:\agenda - Sauvegarde.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
  
       End Sub

 

[ROGER2327]

Re : Bug a la fermeture d'un classeur

Bonjour,

Avez-vous essayé ceci ?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If MsgBox("Voulez vous enregistrer les modifications sur une clé USB ?", _
        vbQuestion + vbYesNo, "ENREGITRE LES MODIFICATIONS") = vbYes Then
        MsgBox "Attention insérer une clé USB pour la sauvegarde ", vbInformation + vbOK
        ChDir "H:\"
        ActiveWorkbook.SaveAs Filename:="H:\agenda - Sauvegarde.xls", _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
    End If
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\SEV\Documents\comptes\agenda.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub

Bonne journée,
ROGER2327

 

[sev]

Re : Bug a la fermeture d'un classeur

Ce nouveau code me met toujours une erreur si je veux pas enregistrer le classeur !

 

[Compte Supprimé 979]

Re : Bug a la fermeture d'un classeur

Bonsoir Sev, Roger2327,

Sev, essaye ce code

Dim VPath As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If MsgBox("Voulez vous enregistrer les modifications sur une clé USB ?", _
            vbQuestion + vbYesNo, "ENREGITRE LES MODIFICATIONS") = vbYes Then
    ' MEssage pour la clé
    MsgBox "Attention insérer une clé USB pour la sauvegarde ", vbInformation + vbOK
    ' Trouver la lettre de la clé
    Call LettreCléUSB
    ' Si le chemin est vide c'est qu'il n'y a pas de clé
    If VPath = "" Then
      MsgBox "Aucune clé trouvée !" & vbCrLf & vbCrLf _
           & "Sauvegarde et fermeture annulée"
      Cancel = True
      Exit Sub
    End If
    ' Si une clé à été trouvée, sauvegarde dessus
    ActiveWorkbook.SaveAs Filename:=VPath & "agenda - Sauvegarde.xls", _
                          FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                          ReadOnlyRecommended:=False, CreateBackup:=False
  End If
  ' Empècher le message d'erreur si on ne veut pas enregistrer
  On Error Resume Next
  ActiveWorkbook.SaveAs Filename:= _
                        "C:\Users\SEV\Documents\comptes\agenda.xls", FileFormat:=xlNormal, _
                        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                        CreateBackup:=False
  On Error GoTo 0
End Sub
Sub LettreCléUSB()
' Active si ce n'est pas déjà fait
' la Référence Microsoft Scripting Runtime
  On Error Resume Next
  With ThisWorkbook.VBProject.References
    Application.DisplayAlerts = False
    .AddFromFile "C:\WINDOWS\SYSTEM32\scrrun.dll"
  End With
  Application.DisplayAlerts = True
  On Error GoTo 0
  Dim Fso As Object, FlgFind As Boolean, VTemp As String
[COLOR=blue] Dim Drv As Object[/COLOR]
[COLOR=blue] Const Removable = 1[/COLOR]
  Set Fso = CreateObject("Scripting.FileSystemObject")
  ' Flag de la clé trouvée
  FlgFind = False
  VPath = ""
  ' Teste pour chaque lecteur
  For Each Drv In Fso.Drives
    'Empècher les erreurs lors de la recherche
    On Error Resume Next
    ' Le disque amovible est de type = 1
    If Drv.DriveType = Removable Then
      VTemp = Drv.RootFolder
      If Err.Number = 0 Then VPath = Drv.RootFolder
    End If
    On Error GoTo 0
  Next
End Sub

Tu m'en diras des nouvelles

A+

 

[sev]

Re : Bug a la fermeture d'un classeur

Bonsoir,
Les variables de Drv et Removable ne sont pas déclarées.
J'ai essayée de les déclarer en Variant mais cela me met un messagebox : aucune clé trouvée sauvegarde et fermeture annulée !

 

[Compte Supprimé 979]

Re : Bug a la fermeture d'un classeur

Salut Sev,

Si tu veux les déclarer ou obligé avec "Option Explicit"
Il suffit de mettre en début de la sub

Sub LettreCléUSB()
  Dim Drv As Drive
  Const Removable = 1
  'Etc .....

Voilà

 

[sev]

Re : Bug a la fermeture d'un classeur

Cela me met une erreur de compilation :
Type défini par l'utilisateur non défini

Je ne maitrise pas la VBA , j'essaye de comprendre en appliquant des codes à mes classeurs

 

[Compte Supprimé 979]

Re : Bug a la fermeture d'un classeur

Salut Sev,

Le problème de la variable "Drv" c'est qu'elle peut-être déclarée en "Drive" à partir du moment ou la référence "Microsoft Scripting Runtime" est cochée.

Donc déclare ta variable en Objet

Dim Drv As Object

Voir mon code modifié plus haut

Voilà A+

 

[sev]

Re : Bug a la fermeture d'un classeur

Bonjour ,
Je ne comprends pas , j'ai toujours le même problème ???

 

[Compte Supprimé 979]

Re : Bug a la fermeture d'un classeur

Re,

Ben alors, laisse tomber l'idée

Ou alors joins nous ton fichier !

A+

 

[sev]

Re : Bug a la fermeture d'un classeur

Je joint le fichier après une sévère cure d'amaigrissement

 

[Compte Supprimé 979]

Re : Bug a la fermeture d'un classeur

Re,

Dans le fichier joint tu as une Sub sans End Sub

Private Sub Workbook_Open()

A supprimer du code

Sinon le reste fonctionne chez moi,
Tu as qu'elle version d'office et de windows ?

A+

 

[sev]

Re : Bug a la fermeture d'un classeur

J'ai Excel 2003 et Vista