RE
VOICI LE CODE
dans mon usf j'ai ceci qui renvoie a un module
Private Sub EnregistrerSous_Click()
Enregistrer
End Sub
Sub Enregistrer()
'Test présence répertoire
Repertoire = "C:\Mes documents\"
If Dir(Repertoire, vbDirectory) = "" Then
MkDir (Repertoire)
End If
'Nouveau nom de fichier
Prenom = InputBox("ENTREZ VOTRE PRENOM")
Nom = InputBox("ENTREZ VOTRE NOM")
Aujourdhui = Format(Now, "dd mmmm yyyy")
Heure = Format(Now, "hh")
Minutes = Right(Format(Now, "hh:mm"), 2)
NomFichier = Prenom & " " & Nom & " " & Aujourdhui & " " & Heure & "h" & Minutes
NomEtChemin = Repertoire & "\" & NomFichier
'Enregistrement sous
EnregistrerSous:
FichierEnregistrerSous = Application.GetSaveAsFilename(NomEtChemin, _
fileFilter:="Fichiers Microsoft Excel (*.xls), *.xls")
If FichierEnregistrerSous <> False Then
Affichage = MsgBox("Vous allez enregistrer " & NomFichier & " sous :" & _
Chr(10) & Chr(10) & FichierEnregistrerSous, , "Enregistrement du fichier")
Else
GoTo LaFin
End If
If Dir(FichierEnregistrerSous) <> "" Then
Affichage = MsgBox("Un fichier du même nom existe déjà à cet emplacement." & _
Chr(10) & Chr(10) & "Renommez le ou supprimer le.", vbExclamation, "NDLR")
GoTo EnregistrerSous
End If
ActiveWorkbook.SaveAs Filename:=FichierEnregistrerSous, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=True
LaFin:
End Sub
car apres l'activation de ce bouton, je memorise la personne la date et l'heure de l'enregistrement ....
mais comme c'est un gros fichier il mets du temps pour faire la save, c'est pour ca j'aurrai voulue une barre de status pendant la save ...
merci pour ton aide
avo