|
Publicité | ||||||||||||||||||||||
|
|
#1 |
|
Membre habitué
![]() Date d'inscription: décembre 2006
Messages: 152
|
Bonjour,
j'ai un fichier Excel, et lorsque je le sauvegarde, je souhaite sauvegarder en même temps une copie à un autre emplacement. Pour cela, j'ai ce code : Code :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Chemin = "\\serveur\partage\" ThisWorkbook.SaveAs Chemin & "MaCopie.xls" End Sub Comment faire pour que la copie soit sans code VBA ? Merci
__________________
Quand tu regardes vers le Nord, t'as le "Sud au cul" ... |
|
|
|
|
|
#2 |
|
Expert Confirmé
![]() Date d'inscription: juillet 2008
Localisation: Elsass
Âge: 24
Messages: 1 887
|
Je pense que tu pourrais essayer de supprimer le code par la suite. Quelques idées :
Une contribution de ouskel'n'or pour supprimer les module http://www.developpez.net/forums/d33...fichier-donne/ Le tuto pour piloter l'éditeur de macro http://silkyroad.developpez.com/VBA/VisualBasicEditor/ Après ne te lance pas tout de suite il est probable que quelqu'un ai une méthode directe bien plus simple |
|
|
|
|
|
#3 |
|
Membre Expert
![]() Date d'inscription: septembre 2007
Messages: 1 455
|
Bonjour,
A mon avis tout dépend si tu as du code dans les feuilles ou pas. Si tu n'as pas de code, il te suffit de copier les feuilles dans un nouveau classeur. Sinon je ne vois pas de solution de contournement à part la suppression du code. Edit : Une autre solution possible serait de recopier toutes les données d'un classeur a l'autre, mais dans ce cas je prfère la suppression de macro. Edit2 : Même dans ma version 2003, je viens de me rendre compte que je peux convertir au format 2007 et avec l'extension xlsx plus de macro, je n'ai pas essayé si c'est possible par code, a voir.
__________________
|
|
|
|
|
|
#4 | |
|
Expert Confirmé
![]() Date d'inscription: juillet 2008
Localisation: Elsass
Âge: 24
Messages: 1 887
|
Citation:
Mais si cela est possible c'est la solution la plus simple |
|
|
|
|
|
|
#5 |
|
Membre habitué
![]() Date d'inscription: décembre 2006
Messages: 152
|
Je n'ai pas de code dans les feuilles.
Comment faire pour copier les feuilles dans un nouveau classeur ? En plus, j'ai une dizaine de feuilles... Merci
__________________
Quand tu regardes vers le Nord, t'as le "Sud au cul" ... |
|
|
|
|
|
#6 |
|
Expert Confirmé
![]() Date d'inscription: juillet 2008
Localisation: Elsass
Âge: 24
Messages: 1 887
|
Pour copier les feuilles
Code :
dim ws as worksheet 'déclaration de la variable ws est du type onglet Application.ScreenUpdating = False 'pas de mise a jour de l'écran For each ws in thisworkbook.worksheets 'pour chaque onglet parmis les onglets de ce classeur ws.Copy After:=Workbooks("CopisansMacro.xls").Sheets(Workbooks("CopisansMacro.xls").sheets.count) 'on copy le 'onglet après le dernier du classeur CopisansMacro.xls next ws Application.ScreenUpdating = True 'mise a jour de l'écran Edit : j'ai ajouté les Application.ScreenUpdating |
|
|
|
|
|
#7 |
|
Membre habitué
![]() Date d'inscription: décembre 2006
Messages: 152
|
Merci pour ta réponse, Krovax, mais ça marche pas.
Code :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Chemin = "\\serveur\partage\" dim ws as worksheet 'déclaration de la variable ws est du type onglet Application.ScreenUpdating = False 'pas de mise a jour de l'écran For each ws in thisworkbook.worksheets 'pour chaque onglet parmis les onglets de ce classeur ws.Copy After:=Workbooks(Chemin & "MaCopie.xls").Sheets(Workbooks(Chemin & "MaCopie.xls").sheets.count) 'on copy le 'onglet après le dernier du classeur CopisansMacro.xls next ws Application.ScreenUpdating = True 'mise a jour de l'écran End Sub
__________________
Quand tu regardes vers le Nord, t'as le "Sud au cul" ... |
|
|
|
|
|
#8 |
|
Expert Confirmé
![]() Date d'inscription: juillet 2008
Localisation: Elsass
Âge: 24
Messages: 1 887
|
Ca ne marche pas? C'est normale!
Ca n'a pas de pattes (j'adore cette phrase) Il faudrait peut être ouvrir le classeur avant de faire la copie, (et le fermer en enregistrant sans doute) Je te laisse lire l'aide sur open et close bon allez sans tester Code :
dim ws as worksheet dim chemin as string 'on déclare les variables et on le défini après les déclaration sinon.... c'est le drame Chemin = "\\serveur\partage\" Workbooks.Open Filename:=Chemin & "MaCopie.xls" For each ws in thisworkbook.worksheets 'pour chaque onglet parmis les onglets de ce classeur ws.Copy After:=Workbooks("MaCopie.xls").Sheets(Workbooks( "MaCopie.xls").sheets.count) 'on copy le 'onglet après le dernier du classeur CopisansMacro.xls next ws Workbooks("MaCopie.xls").close True |
|
|
|
|
|
#9 |
|
Membre habitué
![]() Date d'inscription: décembre 2006
Messages: 152
|
Super ça fonctionne, bien que j'ai bcp du mal avec le code...
Par contre (et je vais être encore emm...bétant) comment faire pour que dans ma copie ca me rajoute pas les feuilles après, mais plutot que ca m'ecrase les autres pour les remplacer par ceux créé ? Merci
__________________
Quand tu regardes vers le Nord, t'as le "Sud au cul" ... |
|
|
|
|
|
#10 |
|
Expert Confirmé
![]() Date d'inscription: juillet 2008
Localisation: Elsass
Âge: 24
Messages: 1 887
|
Remplacer ca va être lourd a mettre en place enfin c'est surtout que l'on peux faire tellement plus simple a la fin on vire les première feuille
Code :
dim ws as worksheet dom i as integer, n as integer dim chemin as string Chemin = "\\serveur\partage\" Workbooks.Open Filename:=Chemin & "MaCopie.xls" n=Workbooks( "MaCopie.xls").sheets.count 'on stock le nombre de feuille initial For each ws in thisworkbook.worksheets 'pour chaque onglet parmis les onglets de ce classeur ws.Copy After:=Workbooks("MaCopie.xls").Sheets(Workbooks( "MaCopie.xls").sheets.count) 'on copy le 'onglet après le dernier du classeur CopisansMacro.xls next ws 'on supprime les n première feuille for i = 1 to n Workbooks("MaCopie.xls").Sheets(i).Delete next i Workbooks("MaCopie.xls").close True End Sub |
|
|
|
|
|
#11 |
|
Membre Expert
![]() Date d'inscription: septembre 2007
Messages: 1 455
|
aller pour le fun mon code :
Code :
Sub Essai() On Error GoTo fin Dim wb As Workbook Dim num As Integer Dim sh Application.DisplayAlerts = False Application.ScreenUpdating = False num = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Workbooks.Add For Each sh In ThisWorkbook.Sheets Debug.Print sh.Name On Error Resume Next ''sh.Unprotect Attention les feuilles protegees ne seront pas copiées. sh.Copy After:=wb.Sheets(wb.Sheets.Count) On Error GoTo 0 Next sh wb.Sheets(1).Delete fin: If Err.Number > 0 Then MsgBox "Erreur :" & Err.Number & " Description :' & Err.Description" End If Application.DisplayAlerts = False Application.SheetsInNewWorkbook = num Application.ScreenUpdating = True End Sub Edit : Avec ce code les graphiques sont copiés; Les feuilles protégées ne le sont pas. Le nom de la première feuille Feuil1 peut devenir Feuil1(2).
__________________
|
|
|
|
|
|
#12 |
|
Membre Expert
![]() Date d'inscription: septembre 2007
Messages: 1 455
|
J'ai revu mon code, avec en plus la sauvegarde du fichier et la possibilté de copier les feuilles protégées.
Code :
Sub Essai() On Error GoTo fin '----------------------------------' ' Definition des variables '----------------------------------' Dim wb As Workbook Dim num As Integer Dim sh Dim MonFilename As String MonFilename = ThisWorkbook.Path & "\" & "LenomdeMonNouveauClasseur.xls" '-----------------------------------------------------' ' Creation du nouveau classeur avec une seule feuille '-----------------------------------------------------' With Application .DisplayAlerts = False .ScreenUpdating = False num = .SheetsInNewWorkbook .SheetsInNewWorkbook = 1 End With Set wb = Workbooks.Add '-----------------------------------------------------' ' copie des feuilles dans le nouveau classeur ' '-----------------------------------------------------' For Each sh In ThisWorkbook.Sheets On Error Resume Next sh.Unprotect On Error Resume Next sh.Copy After:=wb.Sheets(wb.Sheets.Count) On Error GoTo 0 Next sh wb.Sheets(1).Delete On Error Resume Next wb.SaveAs Filename:=MonFilename On Error GoTo 0 '-----------------------------------------------------' fin: '-----------------------------------------------------' If Err.Number > 0 Then MsgBox "Erreur :" & Err.Number & " Description :' & Err.Description" End If With Application .DisplayAlerts = False .SheetsInNewWorkbook = num .ScreenUpdating = True End With End Sub
__________________
|
|
|
|
|
|
![]() |
||
[XL-2003] Copie de classeur sans macro
|
||
| Outils de la discussion | |
|
|