Microsoft 365 Lenteur macro mise en page

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C

CortoXls

XLDnaute Nouveau
Bonjour à tous

La macro suivante est lente... Presque 2 secondes pour 114 lignes. Auriez-vous une astuce ?

VB: 
Sub Mise_En_Page2() 'Mise en page des onglets avant impression

Dim Derlign As Integer       ' Réf de la dernière ligne utilisée
Dim LastLign As Integer      ' Réf de la dernière ligne

Application.ScreenUpdating = False

If ActiveSheet.Name <> "Liste" And ActiveSheet.Name <> "Indemnités Km" _
And ActiveSheet.Name <> "Loyers" And ActiveSheet.Name <> "Salaires" And ActiveSheet.Name <> "Feuille En-Tête" Then

LastLign = 6
Derlign = 6

LastLign = Range("A:K").Find("*", , , , xlByRows, xlPrevious).Row      'Recherche de la dernière ligne renseignée

Select Case LastLign
    Case Is < 51
        Derlign = LastLign + 3
    Case Is = 54
       Derlign = LastLign
    Case Is < 104
        Derlign = LastLign + 3
    Case Is = 107
        Derlign = LastLign
    Case Else
        Derlign = LastLign + 3
    End Select

ActiveSheet.PageSetup.PrintArea = "A1:J" & Derlign   ' Définition de la zone d'impression avec variable. La colonne "OK" n'est pas imprimée

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$6:$6"                                       'Ligne(s) à reproduire sur chaque page
        .LeftFooter = ""                                                'Pied de page partie gauche
        .CenterFooter = "&G&A" & Chr(10) & "&G&F"                       'Pied de page partie centrale
        .RightFooter = "&10&P / &N"                                     'Pied de page partie droite
        .LeftMargin = Application.InchesToPoints(0.590551181102362)     'Marge gauche
        .RightMargin = Application.InchesToPoints(0.590551181102362)    'Marge droite
        .TopMargin = Application.InchesToPoints(0.590551181102362)      'Marge haute
        .BottomMargin = Application.InchesToPoints(0.590551181102362)   'Marge basse
        .HeaderMargin = Application.InchesToPoints(0.196850393700787)   'Marge en-tête
        .FooterMargin = Application.InchesToPoints(0.196850393700787)   'Marge pied de page
        .PrintHeadings = False                                          'Pas d'impression d'en-tête de lignes et colonnes
        .CenterHorizontally = True                                      'Centrage horizontal
        .CenterVertically = False                                       'Pas de centrage vertical
        .Orientation = xlLandscape                                      'Orientation paysage
        .Draft = False                                                  'Pas d'impression des images
        .Zoom = False                                                   'Pas de zoom
        .FitToPagesWide = 1                                             'Impression 1 page en largeur
        .FitToPagesTall = False                                         'Impression plusieurs pages en longueur si nécessaire
    End With

End If

Application.ScreenUpdating = True

End Sub
Merci d'avance
 
Trier par date Trier par votes
CortoXls à dit:
Bonjour à tous

La macro suivante est lente... Presque 2 secondes pour 114 lignes. Auriez-vous une astuce ?

VB: 
Sub Mise_En_Page2() 'Mise en page des onglets avant impression

Dim Derlign As Integer       ' Réf de la dernière ligne utilisée
Dim LastLign As Integer      ' Réf de la dernière ligne

Application.ScreenUpdating = False

If ActiveSheet.Name <> "Liste" And ActiveSheet.Name <> "Indemnités Km" _
And ActiveSheet.Name <> "Loyers" And ActiveSheet.Name <> "Salaires" And ActiveSheet.Name <> "Feuille En-Tête" Then

LastLign = 6
Derlign = 6

LastLign = Range("A:K").Find("*", , , , xlByRows, xlPrevious).Row      'Recherche de la dernière ligne renseignée

Select Case LastLign
    Case Is < 51
        Derlign = LastLign + 3
    Case Is = 54
       Derlign = LastLign
    Case Is < 104
        Derlign = LastLign + 3
    Case Is = 107
        Derlign = LastLign
    Case Else
        Derlign = LastLign + 3
    End Select

ActiveSheet.PageSetup.PrintArea = "A1:J" & Derlign   ' Définition de la zone d'impression avec variable. La colonne "OK" n'est pas imprimée

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$6:$6"                                       'Ligne(s) à reproduire sur chaque page
        .LeftFooter = ""                                                'Pied de page partie gauche
        .CenterFooter = "&G&A" & Chr(10) & "&G&F"                       'Pied de page partie centrale
        .RightFooter = "&10&P / &N"                                     'Pied de page partie droite
        .LeftMargin = Application.InchesToPoints(0.590551181102362)     'Marge gauche
        .RightMargin = Application.InchesToPoints(0.590551181102362)    'Marge droite
        .TopMargin = Application.InchesToPoints(0.590551181102362)      'Marge haute
        .BottomMargin = Application.InchesToPoints(0.590551181102362)   'Marge basse
        .HeaderMargin = Application.InchesToPoints(0.196850393700787)   'Marge en-tête
        .FooterMargin = Application.InchesToPoints(0.196850393700787)   'Marge pied de page
        .PrintHeadings = False                                          'Pas d'impression d'en-tête de lignes et colonnes
        .CenterHorizontally = True                                      'Centrage horizontal
        .CenterVertically = False                                       'Pas de centrage vertical
        .Orientation = xlLandscape                                      'Orientation paysage
        .Draft = False                                                  'Pas d'impression des images
        .Zoom = False                                                   'Pas de zoom
        .FitToPagesWide = 1                                             'Impression 1 page en largeur
        .FitToPagesTall = False                                         'Impression plusieurs pages en longueur si nécessaire
    End With

End If

Application.ScreenUpdating = True

End Sub
Merci d'avance
Cliquez pour agrandir...
Bonsoir,

Peut-être en en faisant du ménage dans le code.
Retirer les lignes de code non nécessaire. Et en faisant, des tests successifs pour optimiser ton code.
 
Vote positif 0 Vote négatif
cathodique à dit:
Bonsoir,

Peut-être en en faisant du ménage dans le code.
Retirer les lignes de code non nécessaire. Et en faisant, des tests successifs pour optimiser ton code.
Cliquez pour agrandir...
Le code est bien purgé il me semble.
D'autres idées de simplification sachant que j'ai besoin de tous les paramètres que j'ai gardé ?
Est-ce la recherche de la dernière ligne du tableau qui prend du temps ?
 
Vote positif 0 Vote négatif
wDog66 à dit:
Bonjour CortoXls

Peut-être en mettant
VB: 
 ' Au début
 Application.PrintCommunication = False
 ' code de mise en page
 ' A la fin
 Application.PrintCommunication = true
A+
Cliquez pour agrandir...
Bonjour, je n'ai pas le fichier sous la main pour tester tout de suite.
Mais qu'elle est le rôle de cette fonction ?
Trouvé :

Remarques​

Définissez la propriété PrintCommunication sur False pour accélérer l’exécution du code qui définit les propriétés PageSetup .

Définissez la propriété PrintCommunication sur True une fois que les propriétés sont définies pour valider toutes les commandes mises en cache PageSetup.

A tester alors !
 
Vote positif 0 Vote négatif
Bonsoir,


VB: 
Sub Mise_En_Page2()
    ' Mise en page des onglets avant impression
    Dim ws As Worksheet, L As Long, c As Range, m As Double, hm As Double
    ' Affectation de la feuille active
    Set ws = ActiveSheet
    ' Exclure les feuilles non concernées
    If ws.Name = "Liste" Or ws.Name = "Indemnités Km" Or ws.Name = "Loyers" Or ws.Name = "Salaires" Or ws.Name = "Feuille En-Tête" Then Exit Sub
    ' Récupération de la dernière ligne utilisée dans les colonnes A à K
    With ws.Range("A:K")
        Set c = .Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    End With
    ' Si aucune donnée n'est trouvée, L prend la valeur par défaut 6, sinon la dernière ligne trouvée
    L = IIf(c Is Nothing, 6, c.Row)
    ' Si L vaut 54 ou 107, on ne change pas le nombre de lignes, sinon on ajoute 3
    L = IIf(L = 54 Or L = 107, L, L + 3)
    ' Définition de la zone d'impression
    With ws.PageSetup
        .PrintArea = "A1:J" & L
        .PrintTitleRows = "$6:$6"       ' Ligne(s) à reproduire sur chaque page
        .LeftFooter = ""                ' Pied de page partie gauche
        .CenterFooter = "&G&A" & vbCrLf & "&G&F"   ' Pied de page partie centrale
        .RightFooter = "&10&P / &N"      ' Pied de page partie droite
        ' Conversion des marges de pouces en points
        m = Application.InchesToPoints(0.590551181102362)
        hm = Application.InchesToPoints(0.196850393700787)
        .LeftMargin = m: .RightMargin = m: .TopMargin = m: .BottomMargin = m  ' Marges gauche, droite, haute et basse
        .HeaderMargin = hm: .FooterMargin = hm                           ' Marges en-tête et pied de page
        .PrintHeadings = False         ' Pas d'impression d'en-tête de lignes et colonnes
        .CenterHorizontally = True     ' Centrage horizontal
        .CenterVertically = False      ' Pas de centrage vertical
        .Orientation = xlLandscape     ' Orientation paysage
        .Draft = False                 ' Pas d'impression en mode brouillon
        .Zoom = False                  ' Pas de zoom
        .FitToPagesWide = 1            ' Impression sur une page en largeur
        .FitToPagesTall = False        ' Impression sur plusieurs pages en longueur si nécessaire
    End With
End Sub
 
Vote positif 0 Vote négatif
laurent950 à dit:
Bonsoir,


VB: 
Sub Mise_En_Page2()
    ' Mise en page des onglets avant impression
    Dim ws As Worksheet, L As Long, c As Range, m As Double, hm As Double
    ' Affectation de la feuille active
    Set ws = ActiveSheet
    ' Exclure les feuilles non concernées
    If ws.Name = "Liste" Or ws.Name = "Indemnités Km" Or ws.Name = "Loyers" Or ws.Name = "Salaires" Or ws.Name = "Feuille En-Tête" Then Exit Sub
    ' Récupération de la dernière ligne utilisée dans les colonnes A à K
    With ws.Range("A:K")
        Set c = .Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    End With
    ' Si aucune donnée n'est trouvée, L prend la valeur par défaut 6, sinon la dernière ligne trouvée
    L = IIf(c Is Nothing, 6, c.Row)
    ' Si L vaut 54 ou 107, on ne change pas le nombre de lignes, sinon on ajoute 3
    L = IIf(L = 54 Or L = 107, L, L + 3)
    ' Définition de la zone d'impression
    With ws.PageSetup
        .PrintArea = "A1:J" & L
        .PrintTitleRows = "$6:$6"       ' Ligne(s) à reproduire sur chaque page
        .LeftFooter = ""                ' Pied de page partie gauche
        .CenterFooter = "&G&A" & vbCrLf & "&G&F"   ' Pied de page partie centrale
        .RightFooter = "&10&P / &N"      ' Pied de page partie droite
        ' Conversion des marges de pouces en points
        m = Application.InchesToPoints(0.590551181102362)
        hm = Application.InchesToPoints(0.196850393700787)
        .LeftMargin = m: .RightMargin = m: .TopMargin = m: .BottomMargin = m  ' Marges gauche, droite, haute et basse
        .HeaderMargin = hm: .FooterMargin = hm                           ' Marges en-tête et pied de page
        .PrintHeadings = False         ' Pas d'impression d'en-tête de lignes et colonnes
        .CenterHorizontally = True     ' Centrage horizontal
        .CenterVertically = False      ' Pas de centrage vertical
        .Orientation = xlLandscape     ' Orientation paysage
        .Draft = False                 ' Pas d'impression en mode brouillon
        .Zoom = False                  ' Pas de zoom
        .FitToPagesWide = 1            ' Impression sur une page en largeur
        .FitToPagesTall = False        ' Impression sur plusieurs pages en longueur si nécessaire
    End With
End Sub
Cliquez pour agrandir...
Merci beaucoup wDog66 et Laurent950 pour vos propositions !
Demain je vais tester ces deux solutions combinées et je vous tiendrais au courant
Bonne soirée
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
566
candido57
C
M
  • Question Question
Microsoft 365 Imprimer deux zones d'impression provenant de deux onglets sur une seule feuille
Réponses
5
Affichages
541
herve62
herve62
B
  • Résolu(e)
XL 2016 concours / Macro imprimer le texte au maximum selon les pages
Réponses
10
Affichages
700
berru76
B
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
288
Gestionnaire_rh
G
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
368
Phil69970
Phil69970
L
  • Résolu(e)
XL 2019 VBA problème zone d'impression
Réponses
2
Affichages
539
Lionel69890
L
B
  • Question Question
XL 2010 VBA Modification de l’en-tete
2
Réponses
21
Affichages
2 K
BigJose
B
Lu76Fer
  • Question Question
XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)
10 11 12
Réponses
178
Affichages
7 K
TooFatBoy
TooFatBoy
C
Excel : Fusionner des cellules en conservant le contenu et la police des cellules à fusionner
Réponses
5
Affichages
152
crocrocro
C
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
P
  • Résolu(e)
XL 2019 Macro qui enregistre en PDF à personnaliser
Réponses
10
Affichages
2 K
pat66
P
U
  • Question Question
Autres {RÉSOLU] Problème macro
Réponses
2
Affichages
663
un internaute
U
S
  • Question Question
Microsoft 365 Macro Pied de page incrusté sur feuilles sélectionnées
Réponses
5
Affichages
905
Syb59
S
Y
  • Question Question
XL 2019 Copie des données des différentes lignes sur une base de données
Réponses
10
Affichages
1 K
YANNISE
Y
S
  • Question Question
Microsoft 365 Mise à Jour dates
Réponses
0
Affichages
527
Stephane Mex
S
P
  • Question Question
XL 2019 Macro qui ralenti mon classeur après exécution
Réponses
2
Affichages
747
pat66
P
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
821
fanfan38
fanfan38
S
  • Question Question
Microsoft 365 Ajout d'une en-tete et pied de page via macro
Réponses
4
Affichages
977
saggigo
S
Y
  • Résolu(e)
XL 2016 Transfère des données réparties sur des lignes à une base de données
Réponses
12
Affichages
2 K
soan
S
Retour