Problème avec code sauvegarde fichier

Version imprimable

Bonjour à tous,

Avec le code suivant j'enregistre ma feuille de calcul avec ses formats.
Cependant, je rencontre un problème.
La feuille clignote plusieurs fois avant de se réduire, c'est à dire qu'elle est derrière ma feuille principale. Je suis donc obligé de réduire la feuille principale pour laisser apparaître la feuille de bon de commande afin de la fermer.

Je n'arrive pas à faire en sorte que lorsque je clique sur le bouton "Sauvegarde", ma feuille se ferme en conservant tous ses formats.
Pouvez-vous m'apporter vos lumières s'il vous plait ?

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\" & "BC" & " " & Cells(17, 4).Value & " " & Cells(15, 14).Value)
        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

SAUVEGARDE

Bonjour Nec14,

Plutôt que de copier des cellules dans un nouveau classeur, tu pourrais directement copier ta feuille en un nouveau classeur, et rompre les liaisons éventuelles.

A adapter à ton cas
Code:

1 2 3 4 5 6 7 8 9 10 Sub essai() Sheets("Feuil2").Copy With ActiveWorkbook tablo = .LinkSources(xlExcelLinks) For i = 1 To UBound(tablo) .BreakLink Name:=tablo(i), Type:=xlExcelLinks Next i .SaveAs Filename:="TOTO.xls" End With End Sub

22/11/2010, 16h24
NEC14

Bonjour Marcel,

Mais est-ce que cette méthode permet de sauvegarder également les formats ? car pour une bonne utilisation de la feuille par la suite cela est très important.
L'utilisateur ne doit pas reparamètrer les formats.
Merci pour ton aide
22/11/2010, 17h02
MarcelG

Bonsoir Nec,

Justement. Cette méthode te fait copier la feuille et avec ses formats, et avec ses valeurs.

Tu peux essayer sur une feuille simplifié avec une seule formule relative à une autre feuille de ton classeur.

Bonjour Marcel,

Voici le code que j'ai fait selon tes recommandations. Cependant je rencontre quelques petits problèmes :
Dans ma feuille de calcul, la cellule B24 correspond au nom du répertoire où doit être sauvegardée la feuille et il est impératif qu'elle y soit. Par exemple si dans la cellule B24 il est indiqué "Patinoire" alors la feuille de calcul doit être sauvegardée dans "S:\........\Patinoire\.......
De plus, la feuille de calcul ainsi sauvegardée doit se fermer automatiquement et ce n'est pas le cas.
Merci par avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub CommandButton1_Click() Sheets("F1").Copy With ActiveWorkbook tablo = .LinkSources(xlExcelLinks) For i = 1 To UBound(tablo) .BreakLink Name:=tablo(i), Type:=xlExcelLinks Next i .SaveAs Filename:=("S:\AGENTS\BON DE COMMANDE\BC 2011\" & "BC" & " " & Cells(17, 4).Value & " " & Cells(15, 14).Value) End With End Sub

23/11/2010, 10h24
MarcelG

Enregistrement

Bonjour NEC14,

Quelles valeurs informent les cellules

Cells(17, 4) et Cells(15, 14)

Quel résultat souhaites-tu obtenir (chemin complet et nom du fichier) ?

Y a-t-il un message d'erreur et à quelle ligne ?

Sinon, pour fermer le classeur après sauvegarde, il suffira d'écrire

Code:

.Close

à l'intérieur de ton instruction With
23/11/2010, 11h54
NEC14
Code:

1 2 3 Cells(17, 4) et Cells(15, 14) Informent du numéro du bon de commande ainsi que la date
Je n'ai aucun message d'erreur, tout se déroule bien. C'est juste une raison pratique. La feuille copiée reste affichée à l'écran et ce n'est pas ce que je veux.

Dans ce cas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub CommandButton1_Click()
 
Dim chemin As String, nomfichier As String
 
chemin = "S:\AGENTS\BON DE COMMANDE\BC 2011\" & Range("B24").Value & "\" & "ta racine secondaire éventuelle" & "\"
nomfichier = "BC " & Cells(17, 4).Value & " " & Cells(15, 14).Value
 
Sheets("F1").Copy
 
With ActiveWorkbook
        tablo = .LinkSources(xlExcelLinks)
        For i = 1 To UBound(tablo)
                .BreakLink Name:=tablo(i), Type:=xlExcelLinks
        Next i
        .SaveAs Filename:=chemin & nomfichier
End With
 
End Sub

A adapter

Ici

Code:

& "ta racine secondaire éventuelle" & "\"

représente le sous-répertoire de "Patinoire".

S'il n'y a pas de sous-répertoire de "Patinoire", alors supprimer la fin de la ligne

et n'oublie pas d'ajouter

Code:

.Close

juste avant l'instruction "End With"