RESOLU : Code VB "enregistrer sous"

RESOLU : Code VB "enregistrer sous" - VB/VBA/VBS - Programmation

Marsh Posté le 26-01-2006 à 10:26:24    

Bonjour,
 
Je cherche un code VB pour enregistrer "sous" mes fichiers Excel en fonction des critères suivants (variables) :
 
- Cellule A1 = client
- Cellule A2 = prenom
 
 
Le code VB doit donc enregistrer mes fichiers en fonction des parametres ci-dessus (variables)
 
C:/client/prenom.xls
 
 
Si possible, le code doit permettre de reperer si le ficher existe deja.
Si ce n’est pas possible, le fichier portera le nom suivant
 
C:/client/prenom jj mm aa hh mm ss.xls
 
*****
 
Thanks !

Message cité 1 fois
Message édité par juans le 30-01-2006 à 15:33:37
Reply

Marsh Posté le 26-01-2006 à 10:26:24   

Reply

Marsh Posté le 26-01-2006 à 11:53:06    

Bonjour juans,
 

juans a écrit :

Je cherche un code VB pour enregistrer "sous" mes fichiers Excel en fonction des critères suivants (variables) :
- Cellule A1 = client
- Cellule A2 = prenom


Pour enregistrer :

Code :
  1. 'Ton chemin pour l'enregistrement
  2.     Dim Chemin
  3.     Chemin = "c:\"
  4.     'ton nom de fichier
  5.     Dim MonFichier
  6.     Monfichier = Chemin & Range("A1" ).value & "_" & "Range("A2" ).value & ".xls"
  7.     ActiveWorkbook.SaveAs Filename:= MonFichier, _
  8.         FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  9.         ReadOnlyRecommended:=False, CreateBackup:=False


 

juans a écrit :

Le code VB doit donc enregistrer mes fichiers en fonction des parametres ci-dessus (variables)
C:/client/prenom.xls

Un nom de fichier ne contient pas de "/" mais des "\" pour séparer le noms des répertoires ! Dans le nom même du fichier ces caractères ne sont par ailleur pas autorisés.
 

juans a écrit :

Si possible, le code doit permettre de reperer si le ficher existe deja.


Pour tester l'existence d'un fichier, tu peux utiliser ce genre de choses :

Code :
  1. Sub main()
  2. Dim MonFichier, Chemin
  3. Chemin = "C:\Documents and Settings\"
  4. MonFichier = "blabla.xls"
  5. MsgBox FichierExiste(Chemin, MonFichier)
  6. End Sub
  7. Function FichierExiste(ByVal Chemin As String, ByVal Fichier As String) As Boolean
  8. With Application.FileSearch
  9.     .LookIn = Chemin
  10.     .Filename = Fichier
  11.     FichierExiste = .Execute
  12. End With
  13. End Function

Il existe d'autres méthode via fileexists (filesystemobject)...
a toi de voir
@+


---------------
Je bidouillle c'est sur... Mais j'essaye de faire en sorte que ça marche ;-)
Reply

Marsh Posté le 26-01-2006 à 18:08:29    

J'ai essayé de bidouiller ce code mais je n'arrive pas au resultat voulu.
 
La cellule A1 doit donner le nom du dossier qui doit se creer
 
La cellule A2 donne le nom du fichier (*.xls) et doit etre capable de mettre l'heure de l'enregistrement a la fin du nom du fichier
 
Resultat attendu :  C:/client/prenom_hh:mm
 
Rappel : ce module est executé a partir d'un CommandButton
 

Reply

Marsh Posté le 26-01-2006 à 18:18:55    

ok !  
Et ça bloque où? sur quoi? Quel code as-tu?
les ":" sont interdits aussi dans les noms de fichier... Utilise des "\" , ça ira peut-être déjà mieux ;)
 
@+


---------------
Je bidouillle c'est sur... Mais j'essaye de faire en sorte que ça marche ;-)
Reply

Marsh Posté le 26-01-2006 à 18:30:44    

peut être que juans est sur mac donc / serait correcte
 
dir(monfichier) retourne "" si le fichier est inexistant.
 
donc  
 
Monfichier = "c:/" & [a1] & "/" & [b1]
 
if dir(monfichier & ".xls" <>"" then
monfichier = monfichier & " " & now
end if
monfichier = monfichier & ".xls"
 
thisworkbook.save monfichier
 
 
Bon voilà, ça si c'est t'es sur un mac. Pour windows, il faut remplacer "/" par "\"
 
++ et bonne prog

Reply

Marsh Posté le 26-01-2006 à 18:32:30    

oups, remplace [b1] par [a2], ce sera mieux
 
pour rappel, la notation [a2] équivaut à eval("a2" ) ou encore range("a2" )

Reply

Marsh Posté le 26-01-2006 à 18:43:52    

Cool je connaissais pas cette notation [a1] , bien pratique...
merci au passage ;)
 
J'avais effectivement pas pensé à mac pourtant j'en ai 3 à la maison mais j'ai pas de crosoft dessus ;)


---------------
Je bidouillle c'est sur... Mais j'essaye de faire en sorte que ça marche ;-)
Reply

Marsh Posté le 27-01-2006 à 12:55:51    

Non je suis sur PC... mais je suis vraiment pas une star en programmation!
 
Je bosse dessus et je donne mon code d'ici 15h00

Reply

Marsh Posté le 27-01-2006 à 18:06:52    

Voici mon code final mais qui ne marche pas !!!
 
*********
 
Private Sub CommandButton1_Click()
 
monfichier = "c:\" & Range("a1" ).Value & "\" & Range("b1" ).Value & Range("c1" ).Value
 
If Dir(monfichier & ".xls" ) <> "" Then
 
monfichier = monfichier & " " & Now
End If
monfichier = monfichier & ".xls"
 
ThisWorkbook.SaveCopyAs monfichier
 
End Sub
 
********
 
 
Problemes rencontres :
  - la creation de dossier ne marche pas
  - le ficher fonctionne quand le dossier est créé au prealable
  - le format "Now" ne fonctionne pas
 

Reply

Marsh Posté le 28-01-2006 à 21:03:49    

Bonjour,

Reply

Marsh Posté le 28-01-2006 à 21:03:49   

Reply

Marsh Posté le 28-01-2006 à 21:05:27    

Bonjour,
Il faut tout d'abord créer le dossier si il n'existe pas:
 

Reply

Marsh Posté le 28-01-2006 à 21:44:32    

Bonjour,
Il faut tout d'abord créer le dossier si il n'existe pas:
On error resume next  'ne prend pas en compte l'erreur si le dossier existe déjà
mkdir "c:\" & Range("a1" ).Value
on error goto 0
 
Now renvoie un format date soit de type JJ/MM/AA HH:MM:SS, les barres obliques '/' et les ':' ne sont pas acceptées comme nom de fichier. Si on souhaite intégré une date dans un nom de fichier on peut utiliser :
jour = Day(Now) & "." & Month(Now) & "." & Year(Now) & " " & Hour(Now) & " " & Minute(Now) & " " & Second(Now)
ou alors plus facile à trier :
 jour = Year(Now) & "." & Month(Now) & "." & Day(Now) & " " & Hour(Now) & " " & Minute(Now) & " " & Second(Now)
 
c'est quoi C1 dans Range("c1" ).Value  
 
je te propose :
 
Private Sub CommandButton1_Click()  
On error resume next  
mkdir "c:\" & Range("a1" ).Value
on error goto 0
 
monfichier = "c:\" & Range("a1" ).Value & "\" & Range("b1" ).Value & Range("c1" ).Value  
 
If Dir(monfichier & ".xls" ) <> "" Then  
jour = Year(Now) & "." & Month(Now) & "." & Day(Now) & " " & Hour(Now) & " " & Minute(Now) & " " & Second(Now)
monfichier = monfichier & " " & jour  
End If  
monfichier = monfichier & ".xls"  
 
ThisWorkbook.SaveCopyAs monfichier  
End Sub  
 
Cordialement
Epéna

Reply

Marsh Posté le 30-01-2006 à 15:32:32    

Voici le code final (un grand merci a Epena :)  )
 
Si la cellule B1 est vide, un UserForm (save_client) proporse de la remplir
 
Le code permet ensuite d'enregistrer (en creant un dossier) une copie du fichier dans le chemin suivant
 
 "c:\Saisie Client\valeur B1\Valeur B1_Client.xls"
 
 
Puis si le fichier existe deja, un nouveau format ajoutant la date permet de ne pas ecraser le precedent :
 
"c:\Saisie Client\valeur B1\Valeur B1_Client aaaa-mm-jj-mm-ss.xls"
 
 
 

Private Sub CommandButton1_Click()
If Range("b1" ).Value = "" Then
save_client.Show
 
End If
 
 
 
On Error Resume Next
MkDir "c:\Saisie Client\" & Range("b1" ).Value
On Error GoTo 0
 
monfichier = "c:\Saisie Client\" & Range("b1" ).Value & "\" & Range("b1" ).Value & "_Client"
   
   
   
If Dir(monfichier & ".xls" ) <> "" Then
jour = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & "." & Minute(Now) & "." & Second(Now)
monfichier = monfichier & " " & jour
End If
monfichier = monfichier & ".xls"
   
ThisWorkbook.SaveCopyAs monfichier
 
save.Hide
 
MsgBox "Sauvegarde terminée."
End Sub


Message édité par juans le 30-01-2006 à 16:48:08
Reply

Marsh Posté le 30-01-2006 à 17:54:36    

salut,
utilise ça pour facilité l'écriture du nom de fichier
jour = format(now, "dd-mm-yy hh mm ss" )

Reply

Marsh Posté le 31-01-2006 à 07:03:56    

C'est effectivement plus élégant.
Epéna

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed