Simplification macro de sauvegarde

Version imprimable

Bonjour à tous,

J'ai fait cette macro qui me permets de sauvegarder la feuille BC1 ainsi que tous ses formats. Pour le moment elle fonctionne bien, mais vous en conviendrez, c'est un peu fastidieux et moche.
Pouvez-vous m'aider à faire quelque chose de plus propre ?
Merci par avance

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
 
Private Sub Sauv1_Click()
Cells.Select
    Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
    Application.Dialogs(xlDialogSaveAs).Show ("S:\AGENTS\BON DE COMMANDE\BC 2010")
        ActiveSheet.PageSetup.PrintArea = "$A$1:$N$72"
        Application.ExecuteExcel4Macro "page.setup(,,0.00,0.00,0.00,false,false,1,1,1,,100,,1,,0.00,0.00,,)"
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$72"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Windows("Factures.xls").Activate
        Sheets("BC1").Select
        Range("B25,G6,H14,N11,N17,N15,N19,B24,A28:A55,N24,I28:I55,J28:J55,K28:K55").Select
        Selection.ClearContents
    Range("A1").Select
        Sheets("BC1").Visible = False
        Sheets("Engagements").Activate
End Sub

27/07/2010, 18h50
pgz

Bonjour.

As-tu pense a faire une simple copie de la feuille dans un nouveau classeur (methode copy de l'objet WorkSheet)?

Cordialement,

PGZ
27/07/2010, 19h34
NEC14

Bonsoir,

Je ne comprends pas ta réponse. Mon code sauvegarde la feuille en cours selon le chemin indiqué tout en préservant tous les formats.
Peux-tu m'expliquer ce que tu veux dire ?
merci
29/07/2010, 10h29
pgz

Bonjour.

Je te propose de copier la feuille entiere, plutot que de copier les valeurs, les formats, ...

Cordialement,

PGZ
29/07/2010, 21h46
NEC14

Bonsoir,

Et comment fait-on celà?
Merci par avance

Code:

1
2
3
4
5
6
Dim wbk As Workbook
Set wbk = Workbooks.Add(1)
   Sheets("BC").Copy before:=wbk.Sheets(1)
   wbk.SaveAs "S:\AGENTS\BON DE COMMANDE\BC 2010\Nom.xls"
   wbk.Close
Set wbk = Nothing

30/07/2010, 11h14
NEC14

Bonjour,

Donc je supprime tout mon code pour le remplacer par ta proposition, c'est bien cela.
Merci
30/07/2010, 11h22
mercatog

Oui, et n'hésite pas d'essayer de comprendre ce qu'on te propose. ta dernière question n'aurait pas dû être posée dès lors.
30/07/2010, 11h25
NEC14

Merci mercatog. Tu as certainement raison. Mais en ce moment de gros problèmes de santé me font beaucoup souffrir et par moment mon cerveau ne suit pas.
Je vais m'efforcer d'appliquer ta recommandation.
A+