[Résolu] Enregistrer un nouveau fichier en gardant le fichier d'origine intact

[racoune]

Bonjour, Bonsoir ou tout ce qui pourra vous plaire.

Pour ne pas vous enquiquiner trop longtemps, voici donc mon problème:

j'essaye tant bien que mal de créer une copie d'un fichier excel. A savoir que la copie doit comporter un autre nom que le fichier d'origine (en gros le fichier d'origine sert de matrice et il est important de garder la matrice telle quelle).

A savoir: j'ai un fichier (excel) A qui sera rempli par les utilisateurs. Une macro basique permet alors de transférer les info sur un autre fichier excel B (qui correspond au fichier d'origine cité ci-dessus). Une fois ce fichier B rempli avec les données en A, une sauvegarde est effectuée pour créer un dernier fichier C dont le titre dépend de cellules.
Mais le hic c'est que je n'arrive pas à sauvegarder une copie de B pour donner C. Soit B disparait pour devenir C, soit je n'arrive pas à renommer C.

Voici le code utilisé (il se trouve dans le fichier A où sont entrées les informations par les utilisateurs):

Sub nouveaux_patients()
Dim np As Workbook

Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)
 
  np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("D4")
  np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("D5")
  np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("D6")
  np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("D7")
  np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("D8")
  np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("D9")
 
np.SaveAs "D:\" & Range("D4").Value & "" & Range("D5").Value & ".xls"
' la ligne ci-dessus semble buguée mais je ne comprends pas où
    
' ou nf.Save mais dans ce cas pas de modification du nom du fichier de sortie
 
np.Close
 
End Sub

Merci par avance et toutes mes excuses pour mon manque de connaissances en macro/vba

 

[mapomme]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Bonjour racoune,

Allez voir du coté de :

[FONT=&amp]Workbook.SaveCopyAs, méthode[/FONT]
[FONT=&amp]Cette méthode enregistre une copie du classeur dans un fichier sans modifier le classeur ouvert en mémoire.
[/FONT]
[FONT=&amp]Syntaxe[/FONT]
[FONT=&amp]expression[/FONT][FONT=&amp].SaveCopyAs(Filename)
[/FONT]
[FONT=&amp]expression[/FONT][FONT=&amp] : représente un objet Workbook.[/FONT]
[FONT=&amp]Filename[/FONT][FONT=&amp] : Spécifie le nom de fichier de la copie.[/FONT]
[FONT=&amp]
Exemple[/FONT]
[FONT=&amp]Cet exemple montre comment enregistrer une copie du classeur actif.[/FONT]
[FONT=&amp]ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS"[/FONT]

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Bonjour à tous,


Première remarque :
Moins on utilise de caractères spéciaux dans les noms de fichiers et dans les noms des dossiers du chemin d'accès aux fichiers, moins on a de risques d'avoir des problèmes d'accès à ces fichiers, et le caractère "espace" est un caractère spécial.

Donc première question :
Dans ta ligne "np.SaveAs", as-tu essayé de simplement remplacer le & " " & par un truc du genre & "_" & ?

Ou peut-être essayer cette syntaxe :
MonFichier="D:\" & Range("D4").Value & "_" & Range("D5").Value & ".xls"
np.SaveAs Filename:=MonFichier, FileFormat:=xlNormal


Deuxième remarque :
Ce que tu appelles ici "trame" semble être un "modèle".
Or les fichiers .xls ne sont pas exactement fait pour être utilisés comme des modèles. Il y a les fichiers .xlt qui sont faits exactement pour ça.

Les .xls et les .xlt sont identiques. Ce sont leurs utilisations qui diffèrent.
Exemple avec un .xls : on ouvre un .xls, puis on le modifie. Si on fait une sauvegarde, ça enregistre les modifications dans ce fichier, sauf si on passe par "Enregistrer sous..." pour enregistrer une copie de ce fichier sous un autre nom.
Exemple avec un .xlt : on ouvre un .xlt, puis on fait des modifications dans le fichier. Si on veut le sauvegarder, on constate qu'on est obligé de passer par "Enregistrer sous...", ce qui est normal puisque le fichier n'a pas vraiment de nom pour l'instant.

Le fichier .xlt est ainsi à l'abri d'une modification par inadvertance.

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Bonjour à vous.

Alors, mapomme, merci pour les info. Il est vrai que pour la syntaxe expression.SaveCopyAs(Filename), je pensais pouvoir utiliser "np" comme expression mais ça ne semble pas possible.
Il me faut donc essayer un ActiveWorkbook en espérant que celui qui soit activé correspond bien au fichier nouvellement créer (donc à partir du fichier B) et non celui sur lequel on entre les info (fichier A).

Pour ta part, Marcel32, j'ai bien essayé de replacer l'espace mais ça n'y change rien.
Sinon la trame est bien un modèle. En effet il faut essayer de passer par un .xlt comme tu sembles le supposer.

En gros, je vais tester vos trois propositions (activeworbook , la nouvelle syntaxe et le .xlt) et vous tiens au courant.

Euh... seulement, ce problème est une première requête car je risque de vous embêter pour l'étape suivante (à savoir utiliser une macro pour générer la création de plusieurs fichiers de la même manière. A ajouter que les info de chaque colonne du fichier A donneront un fichier C1, C2,C3, etc. à partir du modèle fichier B. A préciser que si une colonne du fichier A ne contient aucune info alors il n'y a pas de création de fichier C. Encore un truc pas très clair à expliquer pfff)

En tout cas merci à vous pour votre rapidité de réponse et vos conseils plus qu'intéressants.



EDIT après test:

Alors il suffit de mettre un ActiveWorkbook comme tu l'as dit mapomme et ça fonctionne parfaitement (comme quoi il faut toujours aller au bout des choses).

Donc comme dit au-dessus, je me permets de vous ennuyer encore un peu pour savoir comment permettre la création de plusieurs fichiers C (avec des noms différents fonction des cellules remplies) uniquement si les info sont insérées dans chaque colonne du fichier A. Donc pas de création de fichier C vierge.

Je vous place en fichier joint que les utilisateurs devront remplir. Il faudrait un seul bouton pour lancer une macro générale et non un bouton par colonne comme actuellement.

Très sincèrement merci.

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

L'histoire d'utiliser le .xlt, c'est uniquement pour être sûr de ne pas modifier le modèle accidentellement.


Je ne sais pas si ça va t'aider, mais je viens de regarder dans un classeur que j'avais créé il y a quelques années, et j'utilisais en fait "SaveAS" et "SaveCopyAs" :

Wk_Global.SaveCopyAs Filename:=CheminAcces & NomFichierUnite

Wk_Unite.SaveAs Filename:=CheminParDefaut & NomFichierUnite, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False


[edit]
Cool, je vois que tu as réussi grâce à la réponse de MaPomme.
[/edit]

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Oh mais tu m'as bien aidé, marcel32. Simplement j'ai testé la solution de mapomme avant les tiennes et il s'est avéré que ça fonctionne parfaitement.
Par contre, pour ne pas vérolé le fichier d'origine, je vais verrouiller tout le fichier exceptés les cellules à remplir.

Mais tout n'est pas fini car comme tu as du le lire auparavant, une deuxième requête s'est greffée à la première (en fait c'est la continuité).

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Oui, j'ai lu ta nouvelle requête et j'ai regardé ton fichier.

J'ai d'abord pensé qu'un UserForm serait mieux adapté, mais ça risque de nous emmener loin...

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Oh pas trop loin non plus sinon tu risques de dépasser mes compétences et me perdre.

Dans tous les cas je tente quelque chose et on verra ce que ça peut donner.

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Bon, le code commence à me dévorer et ça n'avance à rien.

Voici le code actuellement en cours:

Sub colonne_D()
Dim np As Workbook

Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)
 
If IsEmpty("D5") Then MsgBox ("Rien à créer")
  
  Else
  np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("D4")
  np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("D5")
  np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("D6")
  np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("D7")
  np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("D8")
  np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("D9")
   
  ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
    
np.Close

End If

    Range("D4:D9,F4:F9,H4:H9,J4:J9,L4:L9,D19:D24,F19:F24,H19:H24,J19:J24,L19:L24"). _
        Select
    Selection.ClearContents
    Range("D4").Select
 
End Sub

Hélas le Else n'est pas pris en compte (une alerte me parle d'une erreur de compilation avec un Else sans If pourtant le If y est).

En gros j'essaye de créer une condition (une cellule non vide) pour lancer la création d'un fichier.
Si la cellule en question est vide, un simple message indique à l'utilisateur que rien n'est créé. Par contre si la cellule est remplie alors le fichier est créé puis toutes les informations sont effacées du tableau.

Deux problèmes:
1: impossible de créer une condition If Then Else convenable (pour le Else, est-il possible d'envoyer vers une autre macro pour alléger le code?)
2: comment optimiser le code car je vais devoir créer 10 conditions (10 cellules différentes mais un seul bouton pour lancer une seule macro)?


Et encore désolé pour ces questions de débutant

[EDIT] petit test avec l'appel d'une macro via Call mais... pas très concluant.

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Exemple pour envoyer vers une macro nommée "Macro1" ou vers une macro nommée "Macro2" :

IF a=b THEN
    Macro1
ELSE
    Macro2
END IF

Remarque : le "CALL" est implicite donc facultatif (perso, je le met quand même )


Tu n'as que 10 clients ???

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Ok donc pas besoin d'inscrire le call.
Je vais donc partir de ton exemple pour réécrire le code (histoire de vérifier que le if fonctionne bien).

Sinon il y a plus de 10 clients mais il faut bien avoir une base.

[EDIT] (j'adore éditer)

Donc le code actuel fonctionne mais ça me parait très long:

Sub depart()
If Range("D5") = "" Then
    macro1
Else
    Macro2
End If
If Range("F5") <> "" Then
    Macro3
End If
If Range("H5") <> "" Then
    Macro4
End If

    Range("D4:D9,F4:F9,H4:H9,J4:J9,L4:L9,D12:D17,F12:F17,H12:H171,J12:J17,L12:L17"). _
        Select
    Selection.ClearContents
    Range("D4").Select

End Sub
Sub macro1()
MsgBox ("rien à faire")
End Sub
Sub Macro2()
Dim np As Workbook

Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)
 
  np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("D4")
  np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("D5")
  np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("D6")
  np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("D7")
  np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("D8")
  np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("D9")
   
  ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
    
np.Close
  
End Sub
Sub Macro3()
Dim np As Workbook

Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)
 
  np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("F4")
  np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("F5")
  np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("F6")
  np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("F7")
  np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("F8")
  np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("F9")
   
  ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
    
np.Close
  
End Sub
Sub Macro4()
Dim np As Workbook

Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)
 
  np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("H4")
  np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("H5")
  np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("H6")
  np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("H7")
  np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("H8")
  np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("H9")
   
  ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
    
np.Close
  
End Sub

N'y a t'il pas moyen d'optimiser ce code, de le condenser? Parce que pour l'exemple, il n'y a que 3 patients pris en compte sur les 10 possible. Pas que ça me gène mais ça ne fait pas très sérieux, non?

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

Je ne suis pas certain que tu partes dans la bonne direction pour ton projet final, mais en gardant ton code on peut l'"optimiser" en remplaçant les macros "Macro2", "Macro3" et Macro4" par une seule "MacroX" en lui passant un paramètre pour qu'elle sache sur quelle colonne elle doit travailler.

Cela pourrait donner quelque chose comme ça :

Sub Depart()

    If Range("D5") = "" Then
        MsgBox ("rien à faire")
    Else
        MacroX (NumeroPatient)
        
    End If

    Range("D4:D9,F4:F9,H4:H9,J4:J9,L4:L9,D12:D17,F12:F17,H12:H171,J12:J17,L12:L17").ClearContents
    Range("D4").Select

End Sub

Sub MacroX(NumPat As Long)
Dim np As Workbook

    Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)

    np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("B4").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("B5").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("B6").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("B7").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("B8").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("B9").Offset(0, 2 * NumPat)

    ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
     
    np.Close

End Sub

Reste à savoir comment connaître le numéro du patient...
Faut-il prévoir une cellule pour saisir le numéro du patient (par exemple en B13), ce qui changerait la macro "Depart" en ceci :

Sub Depart()

    If Range("D5") = "" Then
        MsgBox ("rien à faire")
    Else
        If Range("B13") = "" Then
            MsgBox ("Saisir le numéro du patient en cellule B13")
        Else
            MacroX (Range("B13"))
        End If
    End If

    Range("D4:D9,F4:F9,H4:H9,J4:J9,L4:L9,D12:D17,F12:F17,H12:H171,J12:J17,L12:L17").ClearContents
    Range("D4").Select

End Sub

Mais tu es bien conscient que la logique de ton code n'est pas "optimisée" :

- Si la cellule D5 est vide, on ne fait rien, même si les autres cellules (F5, G5, etc.) ne sont pas vides...

- On voit que si D5 est vide, tu affiches le message "Rien à faire", puis tu effaces toutes les cellules de ton tableau...
Ne faudrait-il pas n'effacer (à supposer que l'effacement soit nécessaire) que la colonne traitée, et donc mettre la partie effacement dans la macro qui traite la colonne ?

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

tu penses que ça part en sucette? Comment ça? Cela voudrait-il dire qu'une macro ne convient pas parfaitement à la demande?

C'est vrai que j'essaye de faire un peu joujou avec les macro donc c'est pour cette raison que je suis parti là-dessus.

Sinon merci pour l'idée de l'optimisation.

 

[TooFatBoy]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

J'ai fait une fausse manip qui a effacé ce que j'avais saisi, donc j'ai tout retapé et édité pendant que tu répondais et du coup nos messages se sont croisés.
Je crois donc que tu devrais relire mon message précédent pour voir les compléments d'informations que j'ai ajoutés.


Donc, pour continuer, en gardant ton code et en essayant d'enlever les problème de logique de celui-ci, ça pourrait donner un truc comme ça :

Sub Depart()

    If Range("B13") = "" Then
        MsgBox ("Saisir le numéro du patient en cellule B13")
    Else
        TraitementColonne (Range("B13"))
    End If

End Sub

Sub TraitementColonne(NumeroPatient As Long)

    If Range("B5").Offset(0, 2 * NumeroPatient) = "" Then
        MsgBox ("rien à faire")
    Else
        MacroX (NumeroPatient)
    End If

End Sub

Sub MacroX(NumPat As Long)
Dim np As Workbook

    Set np = Application.Workbooks.Open("D:\TRAME TOMO.xls", True)

    np.Worksheets("plan Ttt").Range("B2") = ThisWorkbook.Worksheets("Feuil1").Range("B4").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("B1") = ThisWorkbook.Worksheets("Feuil1").Range("B5").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("D15") = ThisWorkbook.Worksheets("Feuil1").Range("B6").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("H15") = ThisWorkbook.Worksheets("Feuil1").Range("B7").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("F15") = ThisWorkbook.Worksheets("Feuil1").Range("B8").Offset(0, 2 * NumPat)
    np.Worksheets("plan Ttt").Range("B27") = ThisWorkbook.Worksheets("Feuil1").Range("B9").Offset(0, 2 * NumPat)

    ActiveWorkbook.SaveAs "D:\" & Range("B2").Value & "_" & Range("B1").Value & ".xls"
     
    np.Close

    Range("B4:B9").Offset(0, 2 * NumPat).ClearContents
    Range("D4").Select

End Sub

Remarque : les passages de paramètre sont ici inutiles puisqu'on utilise toujours la cellule B13, mais c'est pour te montrer comment ça fonctionne.

 

[racoune]

Re : Enregistrer un nouveau fichier en gardant le fichier d'origine intact

ok marcel, je comprends mieux ton message à présent mais le problème de ta proposition c'est que la macro ne fonctionnerait que patient par patient alors que je souhaite créer les fichiers pour 1 à 10 colonnes (patient) en même temps en ne cliquant qu'une fois sur un bouton.

J'ai donc lancé des If - Then - Else avec comme condition "la première case de la colonne remplie permet de créer le fichier avec les données de la colonne correspondante". Ce n'est pas forcément très beau mais ça fonctionne.

A la fin du code, j'ai lancé une alerte qui, si tu la confirmes, réinitialise le tableau.

Et pour préciser: seules les cases en .4 et .5 (C4 c5, D D5, etc.) doivent obligatoirement être remplie pour la création du fichier (ces deux cases sont importantes car elles donnent le nom au fichier) (seulement, il est préférable pour l'utilisateur d'inscrire le maximum de données afin de ne pas revenir par la suite sur le fichier alors créé.