Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
Vieux 02/07/2009, 12h00   #1
Nouveau Membre du Club
 
Inscription : décembre 2006
Messages : 163
Détails du profil
Informations forums :
Inscription : décembre 2006
Messages : 163
Points : 28
Points : 28
Par défaut Copie de classeur sans macro

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 :
1
2
3
4
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Chemin = "\\serveur\partage\"
    ThisWorkbook.SaveAs Chemin & "MaCopie.xls"
End Sub
Le problème, c'est que ça me garde la macro.
Comment faire pour que la copie soit sans code VBA ?

Merci
__________________
Quand tu regardes vers le Nord, t'as le "Sud au cul" ...
Enthau est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 12h22   #2
Membre Expert
 
Avatar de Krovax
 
Inscription : juillet 2008
Messages : 1 889
Détails du profil
Informations personnelles :
Âge : 26

Informations forums :
Inscription : juillet 2008
Messages : 1 889
Points : 1 937
Points : 1 937
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
Krovax est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 12h36   #3
Membre Expert
 
Avatar de aalex_38
 
Inscription : septembre 2007
Messages : 1 570
Détails du profil
Informations forums :
Inscription : septembre 2007
Messages : 1 570
Points : 1 709
Points : 1 709
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.
__________________
aalex_38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 13h03   #4
Membre Expert
 
Avatar de Krovax
 
Inscription : juillet 2008
Messages : 1 889
Détails du profil
Informations personnelles :
Âge : 26

Informations forums :
Inscription : juillet 2008
Messages : 1 889
Points : 1 937
Points : 1 937
Citation:
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.
A condition d'avoir installer la mise a jour pour être compatible avec 2007. Ce qui n'est pas le cas partout (en tout cas c'est pas fait la ou je suis )
Mais si cela est possible c'est la solution la plus simple
Krovax est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 13h17   #5
Nouveau Membre du Club
 
Inscription : décembre 2006
Messages : 163
Détails du profil
Informations forums :
Inscription : décembre 2006
Messages : 163
Points : 28
Points : 28
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" ...
Enthau est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 14h00   #6
Membre Expert
 
Avatar de Krovax
 
Inscription : juillet 2008
Messages : 1 889
Détails du profil
Informations personnelles :
Âge : 26

Informations forums :
Inscription : juillet 2008
Messages : 1 889
Points : 1 937
Points : 1 937
Pour copier les feuilles
Code :
1
2
3
4
5
6
7
8
9
 
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
Ps : Cela ne fonctionnera pas avec les onglet Graphique

Edit : j'ai ajouté les Application.ScreenUpdating
Krovax est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 15h58   #7
Nouveau Membre du Club
 
Inscription : décembre 2006
Messages : 163
Détails du profil
Informations forums :
Inscription : décembre 2006
Messages : 163
Points : 28
Points : 28
Merci pour ta réponse, Krovax, mais ça marche pas.

Code :
1
2
3
4
5
6
7
8
9
10
11
12
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" ...
Enthau est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 17h18   #8
Membre Expert
 
Avatar de Krovax
 
Inscription : juillet 2008
Messages : 1 889
Détails du profil
Informations personnelles :
Âge : 26

Informations forums :
Inscription : juillet 2008
Messages : 1 889
Points : 1 937
Points : 1 937
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 :
1
2
3
4
5
6
7
8
9
10
11
 
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
Krovax est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 17h33   #9
Nouveau Membre du Club
 
Inscription : décembre 2006
Messages : 163
Détails du profil
Informations forums :
Inscription : décembre 2006
Messages : 163
Points : 28
Points : 28
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" ...
Enthau est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 03/07/2009, 08h39   #10
Membre Expert
 
Avatar de Krovax
 
Inscription : juillet 2008
Messages : 1 889
Détails du profil
Informations personnelles :
Âge : 26

Informations forums :
Inscription : juillet 2008
Messages : 1 889
Points : 1 937
Points : 1 937
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 :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
Krovax est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 03/07/2009, 10h19   #11
Membre Expert
 
Avatar de aalex_38
 
Inscription : septembre 2007
Messages : 1 570
Détails du profil
Informations forums :
Inscription : septembre 2007
Messages : 1 570
Points : 1 709
Points : 1 709
aller pour le fun mon code :


Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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).
__________________
aalex_38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 03/07/2009, 10h41   #12
Membre Expert
 
Avatar de aalex_38
 
Inscription : septembre 2007
Messages : 1 570
Détails du profil
Informations forums :
Inscription : septembre 2007
Messages : 1 570
Points : 1 709
Points : 1 709
J'ai revu mon code, avec en plus la sauvegarde du fichier et la possibilté de copier les feuilles protégées.

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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
__________________
aalex_38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +1. Il est actuellement 11h31.


 
 
 
 
Partenaires

Hébergement Web