FORUM Tom's Hardware » Programmation » Autre » [Excel :: Macro VBA] Copier un fichier excel et le renommer
 

[Excel :: Macro VBA] Copier un fichier excel et le renommer

Il y a 208 utilisateurs connus et inconnus. Pour voir la liste des connectés connus, cliquez ici
Ajouter une réponse



 Mot :   Pseudo :  
 
Bas de page
Auteur
 Sujet : [Excel :: Macro VBA] Copier un fichier excel et le renommer
 
laurent350 00
Plus d'informations
n°23434
19-07-2006 à 10:37:12

Bonjour,
 
J'ai un fichier Excel avec plusieurs Sheets. Je voudrais pouvoir le copier (contenu et forme) et enregistrer cet copie sous un autre nom.
 
Je pensais résoudre ce problème en créant un nouveau fichier et en y collant le contenu et la forme du fichier initiale. J'ai trouvé comment créer un nouveau fichier Excel mais je ne sais pas comment copier le contenu et la forme de mon fichier initiale vers le nouveau. Quelqu'un sait-il comment faire?
 
Merci,
 
Laurent

zeb
Profil : Modérateur libre
Plus d'informations
n°23435
19-07-2006 à 10:48:14

Enregistre le tout dans une macro et adapte le code.
 
Pour adapter ce code, tu peux t'aider de ta jujotte, de l'aide en ligne, puis de PPC :)


Message édité par zeb le 19-07-2006 à 10:48:33
laurent350 00
Plus d'informations
n°23445
19-07-2006 à 16:49:55

oui ça je sais faire, voilà ce que ce cela donne...
 

Code :
  1. Sub Ini_RA()
  2. '
  3. ' Ini_RA Macro
  4. ' Macro recorded 18/07/2006 by Laurent
  5. '
  6.     Dim nb As Integer
  7.     nb = 15 'Session number
  8.    
  9.     Dim Counter As Integer 'Counter variable
  10.     Dim PourcentageEffectue As Single 'Pourcentage progress bar variable
  11.    
  12.     'Create a new Workbook named RA.xls 
  13.     Workbooks.Add
  14.     ActiveWorkbook.SaveAs Filename:= _
  15.         "C:\Temp\RA.xls" _
  16.         , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  17.         ReadOnlyRecommended:=False, CreateBackup:=False
  19.     'Create and name sheets
  20.     Dim i, j As Integer
  21.     For i = 4 To nb
  22.         j = i - 1
  23.         Sheets.Add
  24.         Sheets("Sheet" & i).Move After:=Sheets(j)
  25.         Sheets("Sheet" & i).Name = "Session" & i
  26.     Next i
  27.     Sheets("Sheet1" ).Name = "Session1"
  28.     Sheets("Sheet2" ).Name = "Session2"
  29.     Sheets("Sheet3" ).Name = "Session3"
  30.     Sheets("Session3" ).Move After:=Sheets(2)
  31.    
  32.     'Copy model from Copy of RA.xls
  33.     Windows("Copy of RA.xls" ).Activate
  34.     Sheets("Session1" ).Select
  35.     Cells.Select
  36.     Selection.Copy
  37.     Windows("RA.xls" ).Activate
  38.     Dim k As Integer
  39.     For k = 1 To nb
  40.         Sheets("Session" & k).Select
  41.         ActiveSheet.Paste
  42.     Next k
  43.    
  44.     'Page setup
  45.     For k = 1 To nb
  46.    
  47.         'Progress Bar
  48.         Counter = k
  49.         PourcentageEffectue = Counter / nb
  50.         Call UpdateProgress(PourcentageEffectue)
  51.        
  52.         Sheets("Session" & k).Select
  53.         With ActiveSheet.PageSetup
  54.             .LeftMargin = Application.InchesToPoints(0.75)
  55.             .RightMargin = Application.InchesToPoints(0.75)
  56.             .TopMargin = Application.InchesToPoints(1)
  57.             .BottomMargin = Application.InchesToPoints(1)
  58.             .HeaderMargin = Application.InchesToPoints(0.5)
  59.             .FooterMargin = Application.InchesToPoints(0.5)
  60.             .PrintHeadings = False
  61.             .PrintGridlines = False
  62.             .PrintComments = xlPrintNoComments
  63.             .PrintQuality = 300
  64.             .CenterHorizontally = False
  65.             .CenterVertically = False
  66.             .Orientation = xlLandscape
  67.             .Draft = False
  68.             .PaperSize = xlPaperA4
  69.             .FirstPageNumber = xlAutomatic
  70.             .Order = xlDownThenOver
  71.             .BlackAndWhite = False
  72.             .Zoom = False
  73.             .FitToPagesWide = 1
  74.             .FitToPagesTall = 1
  75.             .PrintErrors = xlPrintErrorsDisplayed
  76.         End With
  77.     Next k
  79.     Windows("Mesure.xls" ).Activate
  80.     Sheets("Measure" ).Select
  81.     Unload FrmProgression2
  82. End Sub
  84. Sub UpdateProgress(PourcentageEffectue)
  85.     With FrmProgression2
  86.         .FrameProgress2.Caption = Format(PourcentageEffectue, "0%" )
  87.         .LabelProgress.Width = PourcentageEffectue * (.FrameProgress2.Width - 10)
  88.         .Repaint
  89.     End With
  90. End Sub


En ajoutant ceci pour execution plus rapide

Code :
  1. Private Sub UserForm_activate()
  2.     Application.ScreenUpdating = False
  3.     Call Ini_RA
  4.     Application.ScreenUpdating = True
  5. End Sub


 
Mais n'y a-t-il pas une fonction qui permette directement de copier un fichier entier? Plutôt que de copier ces paramètres un à un?
Car en enregistrant la macro, l'execution est assez lente(peut-être aussi ai-je mal optimisé mon code...)


Message édité par laurent350 00 le 19-07-2006 à 16:53:25
Dimitrifro m31
Plus d'informations
n°23806
31-07-2006 à 10:13:37

Le plus simple c'est d'enregistrer ton fichier sous un autre nom afin d'en créer une copie parfaite et ce en 3 lignes de code :)

zeb
Profil : Modérateur libre
Plus d'informations
n°23808
31-07-2006 à 11:02:43

Citation :

tu peux t'aider de ta jujotte


Dimitrifrom31> +1 :D

Dimitrifro m31
Plus d'informations
n°23813
31-07-2006 à 12:05:33

En fait j'ai été confronté au mêle problème pour le fichier sur lequel je travaille en ce moment (et pour lequel j'ai également demandé de l'aide).
 
Voici mon code (je l'édite un peu pour retirer les morceaux qui te seront inutiles) en espérant que cela te facilite la tâche) :
 

Code :
  1. Sub copiersousunautrenom()
  3. ActiveWorkbook.Save
  4. 'ça c'est pour ne pas perdre le travail effectué sous ton fichier d'origine avec le nom d'origine, ça paraît idiot mais je l'avais pas mis au début.
  5.    
  6.  
  7. jour = Day(Now) & "_" & Month(Now) & "_" & Year(Now)
  8. monfichier = "C:\DOSSIER\" & Sheets("feuil1" ).Range("A1" ).Value & " " & jour
  10. 'ça c'est pour définir le nom de ta copie, ici elle prendra le nom de ta cellule A1 feuille 1 + jour - mois - année
  11.  
  12.    
  13. If Dir(monfichier & ".xls" ) <> "" Then
  14. MsgBox ("Un fichier de ce nom existe déjà, veuillez le supprimer/déplacer avant nouvelle copie" )
  15. Else
  16. monfichier = monfichier & ".xls"
  18.     ActiveWorkbook.SaveAs Filename:= _
  19.         monfichier, _
  20.         FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  21.         ReadOnlyRecommended:=False, CreateBackup:=False
  22.                          
  24.     Workbooks.Open Filename:= _
  25.         "C:\DOSSIER\fichier d'origine.xls"
  26. 'ça c'est si tu veux réouvrir ton fichier d'origine pour faire de nouvelles copies
  27.        
  28.         MsgBox ("Fichier créé dans C:\DOSSIER\" )
  29.             End If
  30.         End Sub


 
Comme tu vois c'est un code tout bête mais ça devrait répondre à ta question.


Message édité par Dimitrifro m31 le 31-07-2006 à 12:11:58

Aller à :
Ajouter une réponse
  FORUM Tom's Hardware » Programmation » Autre » [Excel :: Macro VBA] Copier un fichier excel et le renommer
 

Plan du forum
Forum MesDiscussions.Net, Version 2007.1.2
© 2000-2007 No1Dev
Page générée en 0.339 secondes
Annonces Google
Publicité
Sujets relatifs
voir tout
Actualités relatives
Les dernières actualités
voir tout
Les derniers tests
voir tout
Les ressources relatives
Les téléchargements