Aide pour simplifier un code VBA Excel

Version imprimable

Bonjour à tous,

Est-il possible de simplifier ce code. Si oui, pouvez-vous m'aider car je ne sais pas le faire.
Je vous en remercie beaucoup.

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
Sub mef()
    Range("A1:K56").Select
    Range("K1").Activate
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$56"
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$56"
    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 = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Columns("I:I").Select
    Selection.ColumnWidth = 9.14
    Range("A12").Select
End Sub

Salut a toi,

il est clair que tu ne dois pas avoir besoin de tous ces parametres d'impression mais le probleme est que nous ne savons pas lesquels te sont utiles.

La premiere simplification pourrait etre a suivante :

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
 
Sub mef()
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$56"
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .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 = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Columns("I:I").ColumnWidth = 9.14
End Sub

donne nous plus de details sur les parametres dont tu as besoin...

21/01/2008, 13h17
NEC14

Bonjour,

En fait, lorsque j'enregistre la feuille, je souhaite que la mise ne page soit faite, la zone d'impression sélectionnée. Je fais cela car si un utilisateur veut rééditer la feuille (c'est un bon de commande) il n'est pas à faire toutes ces manipulations.
Merci pour ton aide

ceci devrait etre suffisant alors

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub mef()
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$56"
    With ActiveSheet.PageSetup
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .Zoom = 100
    End With
    Columns("I:I").ColumnWidth = 9.14
End Sub

ça marche à ceci près que les marges ne sont pas à zéro. Comment faire ?

Bonjour,

Pour les marges, j'ai trouvé. Par contre la colonne I ne se met pas à la largeur désirée.
Voici le code tel qu'il est dans mon application, merci pour vos suggestions.

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
Private Sub CmbSave_Click()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$56"
    With ActiveSheet.PageSetup
    Columns("i:i").ColumnWidth = 8.71
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .Zoom = 100
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
    End With
Windows("Factures.xls").Activate
Sheets("FormulCD").Select
Range("g6,h14,k11,k15,d24,d25,a28:j42").Select
Range("a28").Activate
Selection.ClearContents
Range("L11").Select
Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

22/01/2008, 08h16
J.Michel

Bonjour,

Je pense qu'il faut sortir la commande

Code:

Columns("i:i").ColumnWidth = 8.71

du bloc With

Place la après le End With

Amicalement
22/01/2008, 10h57
NEC14

Citation:

Envoyé par J.Michel

Bonjour,

Je pense qu'il faut sortir la commande

Code:

Columns("i:i").ColumnWidth = 8.71

du bloc With

Place la après le End With

Amicalement

Bonjour,
Ok merci. Mais cela ne change rien, la colonne garde sa largeur d'origine
23/01/2008, 10h46
NEC14

Est-ce qu'il serait possible lors de la sauvegarde, de sauvagarder également tous les formas de la feuille originale.
Comment dois-je faire ?

bonjour, une autre proposition pour les mise en page, l'utilisation des macros XL4
L'utilisation des macros excel4 apporte un plus en terme de rapidité

----------------------------------------------------------------

Pour la mise en page les arguments sont les suivants :

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
 
'Arg1 En-tête
'Arg2    Pied de page
'Arg3    Marge Gauche en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg4    Marge Droite en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg5    Marge Haut en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg6    Marge Bas en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg7    Titre FALSE= sans, TRUE =
'Arg8    Grille FALSE ou TRUE
'Arg9    Centré Horizontalement = 1, sinon 0
'Arg10    Centré Verticalement = 1, sinon 0
'Arg11 Orientation - 1 = Portrait, 2 = Paysage
'Arg12 Type de papier - une constante XlPaperSize
'Arg13   Echelle - nombre < 400
'Arg14  Départ numérotation
'Arg15  Ordre d'impression - 1 = haut en bas, 2 = Gauche à droite
'Arg16  Couleur - 0 = avec couleur, 1 = Noir et Blanc
'Arg17  Qualité
'Arg18  En-tête en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg19  Pied de page en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
'Arg20  Commentaire - 0 = sans, 1 = avec
'Arg21  Brouillon - 0 ou 1
 
Application.ExecuteExcel4Macro "PAGE.SETUP(Arg1,Arg2,,,,,,,,,,,,,,,,,,Arg20,Arg21)"
 
----------------------------------------------------------------

les arguments dont tu n'as pas besoin peuvent être omis, place juste les virgules.

cordialement

23/01/2008, 15h22
NEC14

Est-ce que je dois taper toute la liste des arguments qui sont grisés ?
Je connais pas cette façon de faire
23/01/2008, 16h02
fred65200

re

Citation:

les arguments dont tu n'as pas besoin peuvent être omis, place juste les virgules.

cordialement

Ce code est-il bon ? Est-ce la bonne manière de faire ?
Merci pour votre aide.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub CmbSave_Click()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$57"
    With ActiveSheet.PageSetup
Application.ExecuteExcel4Macro "Page.SETUP(arg3 = 0, arg4 = 0, arg5 = 0, arg6 = 0, arg9 = 1, arg10 = 1, arg11 = 1, arg12 = XlPaperSize, arg13 = 100, arg18 = 0, arg19 = 0)"
End With
Windows("Factures.xls").Activate
Sheets("FormulCD").Select
Range("g6,h14,k11,k15,d24,d25,a28:H42").Select
Range("a28").Activate
Selection.ClearContents
Range("L11").Select
Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

23/01/2008, 16h46
fred65200

re

Code:

Application.ExecuteExcel4Macro "Page.SETUP(,, 0, 0, 0, 0, , false, 1, XlPaperSize, 100, ,,,,0, 0)"

@+

Bonjour,

J'ai fait comme indiqué, mais ça ne marche pas.:(

Erreur d'éxécution 438
Propriété ou méthode non géré par cet objet.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub CmbSave_Click()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$57"
    With ActiveSheet.PageSetup
        Application.ExecuteExcel4Macro page.setup(,,0,0,0,0,false,false,1,1,1,xlpapersize,100,,,,,0,0,0,0)
        End With
        Columns("I:I").ColumnWidth = 9.13
Windows("Factures.xls").Activate
Sheets("FormulCD").Select
Range("g6,h14,k11,k15,d24,d25,a28:H42").Select
Range("a28").Activate
Selection.ClearContents
Range("L11").Select
Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

Code:

1
2
3
4
  'With ActiveSheet.PageSetup
        Application.ExecuteExcel4Macro page.setup(,,0,0,0,0,false,false,1,1,1,xlpapersize,100,,,,,0,0,0,0)
       ' End With

enlève les lignes With et End with

@+

Pour la partie que tu m'as indiqué, ça marche, la mise en page se fait correctement. Par contre, je souhaite que la colonne L1:C9 (colonne I) soit à 9.13, ça je n'y arrive pas. Est-il possible d'avoir encore un petit coup de main ? Merci beaucoup

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub CmbSave_Click()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$57"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.00,0.00,0.00,0.00,false,false,1,1,1,,100,,,1,,0.00,0.00,,)"
    Application.ExecuteExcel4Macro "column.width(1,""L1:C9"",9.13)"
Windows("Factures.xls").Activate
Sheets("FormulCD").Select
Range("g6,h14,k11,k15,d24,d25,a28:H42").Select
Range("a28").Activate
Selection.ClearContents
Range("L11").Select
Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

re
Ton code simplifié

Dans la mesure du possible, évite les Select et Selection

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CmbSave_Click()

ActiveSheet.Copy
Columns("I").ColumnWidth = 9.14
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$57"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.00,0.00,0.00,0.00,false,false,1,1,1,,100,,,1,,0.00,0.00,,)"
    'Application.ExecuteExcel4Macro "column.width(1,""L1:C9"",9.13)"
Windows("Factures.xls").Activate
Sheets("FormulCD").Range("g6,h14,k11,k15,d24,d25,a28:H42").ClearContents

Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

cordialement

ça marche beaucoup mieux, à ceci près que seule la zone a1:k57 doit être copiée et enregistrée (il y a des boutons sur la feuille qui ne doivent pas paraitre à la copie). Voici le code avec les corrections que tu m'a donné.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CmbSave_Click()
ActiveSheet.Copy
Columns("i").ColumnWidth = 9.13
Application.Dialogs(xlDialogSaveAs).Show ("S:\FORMULAIRES\BON DE COMMANDE\BC 2008")
    ActiveSheet.PageSetup.PrintArea = "$a$1:$k$57"
    Application.ExecuteExcel4Macro "PAGE.SETUP(,,0.00,0.00,0.00,0.00,false,false,1,1,1,,100,,,1,,0.00,0.00,,)"
    Application.ExecuteExcel4Macro "column.width(9.13,""L1:C9"")"
Windows("Factures.xls").Activate
Sheets("FormulCD").Range("g6,h14,k11,k15,d24,d25,a28:H42,i28:j42").ClearContents
Sheets("FormulCD").Visible = False
Sheets("Engagements").Activate
End Sub

24/01/2008, 15h50
fred65200
re

remplace

Code:

activesheet.copy

par
Code:

1 2 3 Range("A1:K57").Copy Workbooks.Add ActiveSheet.Paste
ce que tu avais mis sans les select

est ce que cette ligne est utile?

Code:

Application.ExecuteExcel4Macro "column.width(9.13,""L1:C9"")"

@+
24/01/2008, 16h15
NEC14

Merci pour toutes les aides apportées