code de mise en page auto

B

brewen

XLDnaute Junior
Bonsoir à tous,

je recherche un code à ajouter à un autre.

Le code actuel duplique un modele de feuille. Seulement il ne tient pas compte de la mise en page (qui et calée à 0 de haut en bas et de droite à gauche), et applique la mise enpage standart.

Quelqu'un aurait il une solution ?

Merci d'avance.
 
Trier par date Trier par votes
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : code de mise en page auto

Bonsoir Brewen

Essaye peut être le code ci dessous :

Code: 
With ActiveSheet.PageSetup
    .LeftMargin = Application.CentimetersToPoints(0.5)
    .RightMargin = Application.CentimetersToPoints(0.5)
    .TopMargin = Application.CentimetersToPoints(1)
    .BottomMargin = Application.CentimetersToPoints(1)
    .HeaderMargin = Application.CentimetersToPoints(0.3)
    .FooterMargin = Application.CentimetersToPoints(0.3)
    .CenterHorizontally = True
    .Orientation = xlPortrait
End With

valeurs en centimètres à adapter à ton besoin.

bonne soirée
@+
 
Vote positif 0 Vote négatif
B

brewen

XLDnaute Junior
Re : code de mise en page auto

Bonsoir pierrot93, jean pierre,

Maladroit dans ma demande, merci quand meme à vous de bien vouloir être mes "quelqu'un" pour ce soir.

J'envoi mon fichier.
La duplication se fait sous le bouton "initialiser le mois"
le pb de mise en page se situe sur les récaps. L'idée est de pouvoir éditer corectement chaque famille de récap.

Merci
 

Pièces jointes

  • caisse.zip
    41.9 KB · Affichages: 14
  • caisse.zip
    41.9 KB · Affichages: 17
  • caisse.zip
    41.9 KB · Affichages: 17
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : code de mise en page auto

Re, bonsoir Jean-Pierre

regarde le code ci dessous :

Code: 
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$AA$54"
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

il definit la zone d'impression et ajuste la page.

@+
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : code de mise en page auto avec Application.ExecuteExcel4Macro "PAGE.SETUP...

bonsoir jeanpierre, Pierrot93, brewen

Remplace le code du Bouton par celui-là.
Les 6 lignes de code ajoutées sont en vert.
Code: 
Sub Bouton1_Clic()
' on suspend le rafraîchissement d'écran; plus rapide, moins mal aux yeux.
[COLOR=DarkGreen][B] Application.ScreenUpdating = False[/B][/COLOR]
'
    If range("AD6") < 1 Or range("AD6") > 12 Then
        MsgBox "Veuillez entrer un mois valide en AD6"
        Exit Sub
    End If
    If range("AD8") < 2000 Then
        MsgBox "Veuillez entrer une année valide en AD8"
        Exit Sub
    End If
    Dim wda As Date, wdb As Date, nbj As Integer, annee As Integer, gwcel As range, btn As Shape
    nbj = CDate("01/" & Format(range("AD6") + 1, "00") & "/" & Format(Year(Date), "0000")) - CDate("01/" & Format(range("AD6"), "00") & "/" & Format(Year(Date), "0000"))
    For i = 1 To nbj
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Format(i, "00")
        Sheets(1).Cells.Copy Destination:=Sheets(Sheets.Count).range("A1")
'mise en page
[B][COLOR=DarkGreen] Application.ExecuteExcel4Macro "PAGE.SETUP(,,0,0,0,0,,,0,,1,9,99,,,,,0,0)"[/COLOR][/B]
'
        Sheets(Sheets.Count).range("AC6:AG17").Clear
        For Each btn In Sheets(Sheets.Count).Shapes: btn.Delete: Next
        Sheets(Sheets.Count).range("O1") = CDate(Format(i, "00") & "/" & Format(Sheets(1).range("AD6"), "00") & "/" & Format(Sheets(1).range("AD8"), "0000"))
    Next i
    
    Sheets.Add after:=Sheets(Sheets.Count)
'mise en page
[B][COLOR=DarkGreen] Application.ExecuteExcel4Macro "PAGE.SETUP(,,0,0,0,0,,,0,,1,9,99,,,,,0,0)"[/COLOR][/B]
'
    With Sheets(Sheets.Count)
        .Name = "Recap_01_14"
        Sheets("Recap").Cells.Copy Destination:=.range("A1")
        .range("A1") = "Récapitulatif du 1 au 14"
        For Each gwcel In .range("A1:AA37")
            If gwcel.Interior.ColorIndex = 43 Then ' N° de couleur à modifier en cas de changement de couleur de reference
               gwcel(1).Formula = "=SUM(01:14!" & gwcel(1).Address & ")"
            End If
        Next
    End With
    With Sheets(Sheets.Count).Buttons.Add(320, 150, 200, 25)
        .OnAction = "GW_lance_1a14"
        .Characters.Text = "Lance la récapitulation"
        .Locked = False
        .LockedText = True
        .Placement = xlFreeFloating
        .PrintObject = False
    End With
    
    Sheets.Add after:=Sheets(Sheets.Count)
'mise en page
[B][COLOR=DarkGreen] Application.ExecuteExcel4Macro "PAGE.SETUP(,,0,0,0,0,,,0,,1,9,99,,,,,0,0)"[/COLOR][/B]
'
    With Sheets(Sheets.Count)
        .Name = "Recap_15_" & Format(i - 1, "00")
        Sheets("Recap").Cells.Copy Destination:=.range("A1")
        .range("A1") = "Récapitulatif du 15 au " & Format(i - 1, "00")
        For Each gwcel In .range("A1:AA37")
            If gwcel.Interior.ColorIndex = 43 Then ' N° de couleur à modifier en cas de changement de couleur de reference
               gwcel(1).Formula = "=SUM(15:" & Format(i - 1, "00") & "!" & gwcel(1).Address & ")"
            End If
        Next
    End With
    With Sheets(Sheets.Count).Buttons.Add(320, 150, 200, 25)
        .OnAction = "GW_lance_15afin"
        .Characters.Text = "Lance la récapitulation"
        .Locked = False
        .LockedText = True
        .Placement = xlFreeFloating
        .PrintObject = False
    End With
    
    Sheets.Add after:=Sheets(Sheets.Count)
'mise en page
[B][COLOR=DarkGreen] Application.ExecuteExcel4Macro "PAGE.SETUP(,,0,0,0,0,,,0,,1,9,99,,,,,0,0)"[/COLOR][/B]
'
    With Sheets(Sheets.Count)
        .Name = "Recap_Mois" & Format(i - 1, "00")
        Sheets("Recap").Cells.Copy Destination:=.range("A1")
        .range("A1") = "Récapitulatif du 01 au " & Format(i - 1, "00")
        For Each gwcel In .range("A1:AA37")
            If gwcel.Interior.ColorIndex = 43 Then   ' N° de couleur à modifier en cas de changement de couleur de reference
               gwcel(1).Formula = "=SUM(01:" & Format(i - 1, "00") & "!" & gwcel(1).Address & ")"
            End If
        Next
    End With
    With Sheets(Sheets.Count).Buttons.Add(320, 150, 200, 25)
        .OnAction = "GW_lance_mois"
        .Characters.Text = "Lance la récapitulation"
        .Locked = False
        .LockedText = True
        .Placement = xlFreeFloating
        .PrintObject = False
    End With
    ThisWorkbook.SaveAs Filename:="CAISSE_" & Format(Sheets("Modele").range("AD8"), "0000") & "_" & Format(Sheets("Modele").range("AD6"), "00") & ".xls"
'on rétablie le rafraîchissement d'écran
[B][COLOR=DarkGreen] Application.ScreenUpdating = True[/COLOR][/B]
End Sub
Je t'ai ajouté la mise en page via les anciennes macro Xl4, plus rapide que VBA,
et les suspension et rétablissement du rafraîchissement d'écran.

pour plus d'info sur PAGE.SETUP
Colo's Excel Junk Room -vba tips en anglais mais accessible.

@+
 
Dernière édition:
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : code de mise en page auto

Re

autre possibilité, si tu veux que cette mise en page s'effectue sur chaque nouvelle feuille, tu peux utiliser la procédure événementielle "NewSheet" de "thisworkbook" comme dans l'exemple ci dessous :


Code à placer dans le module "ThisWorkbook"
Code: 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
With ActiveSheet.PageSetup
    .PrintArea = "$A$1:$AA$54"
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
End Sub

@+
 
Vote positif 0 Vote négatif
B

brewen

XLDnaute Junior
Re : code de mise en page auto

Bonjour à tous,

Je viens de tester le code de fred65200, et le résulat est ok pour moi au niveau mise en page. Maintenant, pour la zone d'impression, je pourrait ajouter des boutons qui imprimerai chaque zone que je souhaite.
Qu'en pensez vous?
Pour le reste de la question de pierrot, j'ai bien peur de ne pas avoir le niveau pour tout comprendre.

A bientot et merci
 
Vote positif 0 Vote négatif
B

brewen

XLDnaute Junior
Re : code de mise en page auto

re pierrot,
Sur ton fichier :
en feuille de récap, le code imprime la première page nickel.
Mais sur la droite, se trouve 3 autres pages récapitulant cheque, refacturation et sortie de caisse. L'impression ne les prend pas en compte. D'ou mon idée d'intégrer des boutons d'impression en haut de page.

merci
 
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : code de mise en page auto

Re

oui, ce code défini une seule zone d'impression, mais sur ton fichier joint je ne voyais qu'une seule récap...

Sinon oui tu peux utiliser des bouton pour modifier la zone à imprimer ou te servir de l'événement "beforprint" du classeur. A voir...

@+
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : code de mise en page auto

bonjour à tous,

pour la fiabilité des macros X4, je ne m'inquiète pas trop.
J'utilise les macros PAGE.SETUP et PRINT depuis plusieurs années.
Elles sont beaucoup plus rapides que les procédures VBA.
D'ailleurs, dans la version Excel 2007, l'éditeur de macro enregistre en utilisant
Application.ExecuteExcel4Macro "PRINT....


cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
721
sousou
sousou
Alison64
  • Question
Microsoft 365 mise en forme conditionnelle
Réponses
2
Affichages
288
JHA
J
J
  • Question
XL 2019 sélection et mise en page avant envoie mail
Réponses
5
Affichages
401
sylvanu
sylvanu
D
  • Résolu(e)
XL 2013 saut de page et mise en page automatique
Réponses
4
Affichages
466
don julio
D
T
  • Résolu(e)
XL 2019 Calculer le nombre de lignes pour impression (pdf ou physique)
Réponses
1
Affichages
134
ThierryP
T
M
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
7
Affichages
406
TooFatBoy
TooFatBoy
D
  • Résolu(e)
Microsoft 365 Mise en page mail/vba
Réponses
10
Affichages
449
Dju1
D
A
  • Question
XL 2016 Boite d'Edgeworth
Réponses
5
Affichages
602
Arno_1111
A
Z
  • Question
Microsoft 365 Mise en forme de tableau et répétition de formule
Réponses
2
Affichages
261
DJunqueira
D
M
  • Résolu(e)
Microsoft 365 Mise en forme conditionnelle: ne pas colorer une cellule non renseignée
Réponses
6
Affichages
379
Mouss3710
M

Membres actuellement en ligne

4 membres et 52 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 727
Messages
2 091 391
Membres
104 907
dernier inscrit
Sunbeth