Re: Nouvelle réponse à Jean-Marc

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

"André" <andre.charrier@tiscali.fr> a écrit dans le message de news: ...
> Jean-Marc,
>
> J'accepte ta propostion

Hello,

bon voici le code corrigé et testé. Je n'ai pas
changé l'esprit du programme, j'ai laissé les choses
se dérouler comme elles le faisaient, sauf quand c'était
clairement erroné.

Concernant la structure, j'ai supprimé les goto qui rendaient
le code confus et j'ai structuré le tout avec un petit while
et quelques If .. Elseif .. Elseif .. End If

Dans tous les cas, j'ai signalé mes changements.
J'ai commenté les endroits où je vois des erreurs de
logique. J'ai aussi commenté les endroits que je trouve
dangereux, libre à toi de les modifier ou non.

J'ai déclaré toutes les variables utilisées,ça m'a permis de
trouver qq bugs. => Toujours déclarer les variables.

Certaines lignes sont longues et seront coupées par ton
logiciel de messagerie, il faudra les "recoller" manuellement.

J'ai testé ce programme sous windows XP. De toute façon, il
n'y a rien ici qui soit OS dépendant, ce code tournera sur
n'importe quel version de Windows.

Mes tests sont faits sous VB6, mais je suis sur que ça marche
identiquement sous VBA.

Je te suggère de lire mes commentaires, ils te permettent
de comprendre ce que j'ai fait au niveau structure du code.
Le code est aisé à suivre, tu pourras en plus vérifier que
cela correspond bien aux specs que tu donnais dans ton mail
précédent.


'
' 8<--------------------------------
'
Sub CopieClasseurXP()
Dim MonFichier As String
Dim disk_ok As Boolean
Dim reponse As VbMsgBoxResult
Dim MatailleE As Long
Dim MatailleD As Long
Dim MatailleA As Long
Dim msg As String, style As Long, titre As String

On Error Resume Next

' enregistre le classeur
ActiveWorkbook.Save

disk_ok = False
While (Not disk_ok)
' il serait mieux de mettre cette msgbox avant le while,
' mais je respecte le code d'origine
MsgBox "Veuillez mettre une disquette", vbOKOnly + vbExclamation,
"Sauvegarde"
MonFichier = Dir("a:*.*")
If Err.Number <> 0 Then
reponse = MsgBox("Pas de disquette dans le lecteur", vbOKOnly +
vbInformation, "Lecteur disquette")
' note : on affecte une réponse mais on ne teste pas le retour!
Quel intérêt ?
' En revanche, il serait judicieux de proposer à l'utilisateur
d'annuler la sauvegarde.
Else
If MonFichier = "DépAnAct.xls" Then ' regarde si la disquette
est DépMalAsDépAnAct.xls
MsgBox "Dernière Sauvegarde le " &
FileDateTime("a:DépAnAct.xls")
disk_ok = True
ElseIf MonFichier = "BACKUP.001" Then ' on accepte que la
disquette contienne un fichier BACKUP.001
disk_ok = True
ElseIf MonFichier = "" Then ' regarde si la disquette est vide
disk_ok = True
Else ' tous les autres cas
msg = "Ce n'est pas la bonne disquette. Veuillez la changer"
style = vbOKOnly + vbExclamation
titre = MonFichier
reponse = MsgBox(msg, style, titre)
' note : on affecte une réponse mais on ne teste pas le
retour! Quel intérêt ?
' En revanche, il serait judicieux de proposer à
l'utilisateur d'annuler la sauvegarde.
End If
End If
Wend

' Ok, on est ici car toutes les conditions sont ok, c'est à dire:
' - Il y a une disquette dans le lecteur A
' - Cette disquette contient soit rien, soit le fichier BACKUP.001,
' soit le fichier DépanAct.xls.
' c'est du moins ce qu'on croit, mais c'est faux. La façon dont le dir
est
' utilisé laisse passer plein de choses, notamment le fait que la
disquette
' puisse contenir d'autres fichiers EN PLUS de ceux que l'on teste. En
effet,
' on ne teste que LE PREMIER nom renvoyé par dir, ce qui ne veut pas
dire
' qu'il n'y a pas d'autres fichiers sur cette disquette. Mais bon, le
code
' original est comme ça, je ne touche à rien.

' ce qui suit est dangereux: que se passe t'il si le répertoire
D:DépMasAl n'existe pas??
' ou si le fichier DépanAct.xls n'existe pas ??
' Il ne se passe rien à cause du On error resume next qui est en début
de procédure
' c'est une très mauvaise habitude. Je laisse le code tel quel, mais à
mon avis
' c'est à revoir.
MatailleD = FileLen("D:DépMalAsDépAnAct.xls")

' Si le fichier dépasse 1 440 000 octets sauvegarde avec backup
If MatailleD > 1440000 Then
Call sauvdisquetteXP
Else
' sauvegarde sur la disquette
Application.StatusBar = Space(15) & "SAUVEGARDE DEPENSES EN COURS"
ActiveWorkbook.SaveCopyAs "e:DépAnAct.xls"

' NOUS Y VOILA
' le fichier sur E va écraser celui su A, et ce dans tous les cas
' pour autant que A ne soit pas protégé en écriture et que le
' nouveau DépanAct.xls ne soit pas trop gros.

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

' je place ici du code de débuggage au cas ou
If Err.Number <> 0 Then
MsgBox "Erreur après Filecopy. Code Erreur : " & Err.Number & _
"Erreur description : " & Err.Description
End If

' donne la taille du fichier intermédiaire sur E
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

' pour la prochaine sauvegarde, supprime du disque le le fichier
créé
' note: on ne fait cela QUE SI LA COPIE EST OK
Kill "e:DépAnAct.xls"
Call Auto_Close ' <== Aucune idée de ce que cela fait
' <== Je le laisse, mais ça peut causer
des trucs bizarres

'Application.StatusBar = Space(15) & "SAUVEGARDE DEPENSES
TERMINEE"
msg = "Fichier Dépenses_Recettes taille " & MatailleE & Chr(13)
& Chr(10) & Chr(10)
msg = msg & "Sauvegarde terminée avec succès"
style = vbOKOnly
reponse = MsgBox(msg, style)
' note : on affecte une réponse mais on ne teste pas le retour!
Quel intérêt ?
Else ' si fichiers différents erreur sauvegarde
msg = "Taille fichier disque " & MatailleE & vbLf
msg = msg & "Taille fichier disquette " & MatailleA &
vbLf & vbNewLine 'retour ligne + saut de ligne
msg = msg & "Veuillez vérifier votre disquette par un formatage
"
style = vbOKOnly + vbExclamation
titre = "Erreur sauvegarde"
reponse = MsgBox(msg, style, titre)
' note : on affecte une réponse mais on ne teste pas le retour!
Quel intérêt ?
' En revanche, il serait judicieux de proposer à l'utilisateur
d'annuler la sauvegarde.
End If
End If

' retourne à l'affichage du bureau
Application.Quit

End Sub

Sub sauvdisquetteXP()
Dim retVal As Variant

' vbNormalFocus = 1
retVal = Shell("e:sXPdépe.bat", vbNormalFocus)
End Sub

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

Voila, si cela ne fonctionne toujours pas dans
ton environnement, c'est qu'il y a un facteur
externe à ce code.

Espérant que cela t'aide,

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

André a écrit :

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

Jean-Marc,

J'accepte ta propostion

André

Merci pour ces éclaircissements.

Je te propose, si ça te convient, de reformater ton code
pour le rendre plus lisible, de corriger ce qui me semble
ne pas aller, et de poster ici même le code reformaté et
corrigé.

NB: le problème ne vient pas d'un kill qui ne marche pas
mais de l'enchainement de tes tests qui ne font pas ce
que tu crois.

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

Salut André,

Essayes de ne pas créer un nouveau fil de discussion à chaque question,
si celle-ci correspond au même thème.
De même essayes de mettre un titre explicite, cela facilite les
recherches sur les archives du groupe.

amicalement

Christophe

Salut,

Ça ne te dérange pas de poster ton courrier personnel (adressé à une seule
personne) sur le forum, les questions des forums ne sont pas nominatives!
Pourquoi tu ne lui envoie pas des emails si c'est privé ???

Merci, au revoir et à bientôt :o)
--
ECRIRE AU TROLL http://irolog.free.fr/letroll/index.html
------------------------------------------------------------
LE TROLL, éleveur de trolls depuis César, qui disait :
Avec une hache, celui qui tient le manche a toujours raison !


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

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

Jean-Marc,

J'accepte ta propostion

André

Merci pour ces éclaircissements.

Je te propose, si ça te convient, de reformater ton code
pour le rendre plus lisible, de corriger ce qui me semble
ne pas aller, et de poster ici même le code reformaté et
corrigé.

NB: le problème ne vient pas d'un kill qui ne marche pas
mais de l'enchainement de tes tests qui ne font pas ce
que tu crois.

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