le lecteur de disquettes continue à tourner

"André" <andre.charrier@tiscali.fr> a écrit dans le message de
news:dff20l$gsd$1@news.tiscali.fr...

Bonjour,


Dans un programme en vba2000 pour enregistrer une sauvegarde sur disquette
j'utilise la macro suivente.
Mon problème Kill n'efface pas la disquette la 1ère fois. Le lecteur A:
continue à tourner jusqu'au message "erreur de sauvegarde..."
Je réutilise la procédure immédiatement après et tout se passe

correctement.

Où est l'erreur.

' efface la disquette
ChDir "a:DépAnAct"
Kill "a:DépAnAct.xls"

' sauvegarde sur la disquette
Application.StatusBar = Space(15) & "SAUVEGARDE DEPENSES EN COURS"

ActiveWorkbook.SaveCopyAs "e:DépAnAct.xls"
FileCopy "e:DépAnAct.xls", "a:DépAnAct.xls"

' donne la taille du fichier intermédiaire sur C
MatailleE = FileLen("e:DépAnAct.xls")
' donne la taile du fichier disquette
MatailleA = FileLen("a:DépAnAct.xls")

' compare les fichiers
' si fichiers identiques la copie est bonne
If MatailleE = MatailleA Then
Application.StatusBar = Space(15) & "SAUVEGARDE DEPENSES TERMINEE"
msg = "Fichier Dépenses_Recettes taille " & MatailleE & Chr(13) &
Chr(10) & Chr(10)
msg1 = "Sauvegarde terminée avec succès"
Style = vkOkOnly
Réponse = MsgBox(msg + msg1, Style)
GoTo LigneQuitter

' si fichiers différents erreur sauvegarde
ElseIf MatailleE <> MatailleA Then
msg1 = "Taille fichier disque " & MatailleE & vbLf
'retour ligne
msg2 = "Taille fichier disquette " & MatailleA & vbLf &
vbNewLine 'retour ligne + saut de ligne
msg3 = "Veuillez vérifier votre disquette par un formatage "
Style = vbOKOnly + vbExclamation
Title = "Erreur sauvegarde"
Réponse = MsgBox(msg1 + msg2 + msg3, Style, Title)
End If

LigneQuitter:
' pour la prochaine sauvegarde, supprime du disque e le fichier créé
Kill "e:DépAnAct.xls"
Call Auto_Close
LigneFin:
' retourne à l'affichage du bureau
Application.Quit

Hello,

ton code comporte un certain nombre d'erreurs de logique.

Pour ton probleme d'erreur, c'est certainement du au fait
que tu tentes un Kill sans t'assurer de l'existence du fichier

En faisant comme ça:
' teste existence de a:depanact.xls
If Dir$("a:DepAnAct.xls") <> "" Then
' ok il existe, on l'efface
Kill "a:DepAnAct.xls"
End If

tu regles déjà une bonne partie du probleme.

voici une version qui marche, et qui corrige les erreurs
de logique.
Notamment, j'ai enlevé les goto qui non seulement
étaient inutiles, mais surtout, ton programme ne
faisait pas ce que tu croyais.
Le plus gros: Si ta copie échouait, tu écrasais quand
même le fichier sur A:, sans doute pas ce que tu souhaitais ....

J'ai enlevé les trucs purement Excel pour faire un test
compplet en VB seul, mais tu sauras adpter le nécessaire.


' 8<-------------------------------------
Option Explicit

Private Sub Command1_Click()
Dim can_kill As Boolean
Dim MatailleE As Long, MatailleA As Long
Dim msg As String

' efface la disquette

' teste existence de a:depanact.xls
If Dir$("a:DepAnAct.xls") <> "" Then
' ok il existe, on l'efface
Kill "a:DepAnAct.xls"
End If
' sauvegarde sur la disquette
' Application.StatusBar = Space(15) & "SAUVEGARDE DEPENSES EN COURS"
Label1.Caption = Space(15) & "SAUVEGARDE DEPENSES EN COURS"

' ActiveWorkbook.SaveCopyAs "e:DépAnAct.xls"
FileCopy "c:DepAnAct.xls", "a:DepAnAct.xls"

' donne la taille du fichier intermédiaire sur C
MatailleE = FileLen("c:DepAnAct.xls")
' donne la taile du fichier disquette
MatailleA = FileLen("a:DepAnAct.xls")

' compare les fichiers
' si fichiers identiques la copie est bonne
If MatailleE = MatailleA Then
Label1.Caption = Space(15) & "SAUVEGARDE DEPENSES TERMINEE"
msg = "Fichier Dépenses_Recettes taille " & MatailleE & vbCrLf
msg = msg & "Sauvegarde terminée avec succès"
MsgBox msg, vbOKOnly
can_kill = True
Else
msg = "Taille fichier disque " & MatailleE & vbCrLf
msg = msg & "Taille fichier disquette " & MatailleA &
vbCrLf
msg = msg & "Veuillez vérifier votre disquette par un formatage "
MsgBox msg, vbOKOnly + vbExclamation, "Erreur sauvegarde"
can_kill = False
End If

' pour la prochaine sauvegarde, supprime du disque e le fichier créé
If can_kill Then
Kill "c:DepAnAct.xls"
End If
' Call Auto_Close

' Application.Quit
End Sub

' 8<-------------------------------------


--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."
mailto: remove '_no_spam_' ; _no_spam_jean_marc_n2@yahoo.fr