Améliorer la rapidité d'exécution Résolu/Fermé

Question

Bonjour, 


Je sollicite à nouveau votre aide. J'ai créé un marco qui fait automatiquement la mise en pages de mets feuille excel (cf. ci-dessous) . Le hic c'est qu'elle met beaucoup de trop de temps pour s'exécuter (1 minute 30 secconde) pour l'ensemble des onglets (32). Comment puis-je l'améliorer pour diminuer le temps d'exécution ? 

D'avance merci pour votre réponse. 

Sub paysage()
'
' Mise en page au format A4 en mode paysage avec en-tête et pied de page personalisé
'
     'Sheets(Array("","")).Select 'détermine les pagess ou sont appliqués les paramètres
   Dim Compteur As Integer, Nom As String
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
            For Compteur = Worksheets.Count To 1 Step -1
                Nom = Sheets(Compteur).Name
                Select Case Nom
                Case "INFO", "PAA-VLT", "site 61 63"
                
                Case Else
                        ' With ActiveSheet.PageSetup 'idem ligne ci-dessous
                        With Sheets(Nom).PageSetup
                            
                            .CenterHeader = "&""Arial,Gras""&20&UPLAN ANNUEL D'INTERVENTION"
                            .LeftFooter = "&8&F" & Chr(10) & "&A"
                            .RightFooter = "&8&D" & Chr(10) & "Page &P/&N"
                            .CenterHorizontally = True
                            .CenterVertically = True
                            .Orientation = xlLandscape
                            .PaperSize = xlPaperA4
                            .FirstPageNumber = xlAutomatic
                            .Order = xlDownThenOver
                            .BlackAndWhite = False
                            .Zoom = 75
                            .PrintErrors = xlPrintErrorsDisplayed
                            .ScaleWithDocHeaderFooter = True
                            .AlignMarginsHeaderFooter = True
                            End With
                End Select
            Next Compteur
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True

End Sub


Configuration: Windows 7 / Internet Explorer 8.0

f894009 · Answer

Re,

avec la macro de selection onglets

Sub test_1()
    Dim TSh() As String
    Dim TSh_NoP, N As Byte
    
    Application.ScreenUpdating = False
    
    N = 0
    TSh_NoP = Array("PAA", "INFO", "site")
    For x = 1 To Worksheets.Count
        If IsError(Application.Match(Sheets(x).Name, TSh_NoP, 0)) Then
            ReDim Preserve TSh(N)
            TSh(N) = Sheets(x).Name
            N = N + 1
        End If
    Next x
    Worksheets(TSh).Select
    
    temps = Timer
    With ActiveSheet.PageSetup
        .CenterHeader = "&""Arial,Gras""&20&UPLAN ANNUEL D'INTERVENTION"
        .LeftFooter = "&8&F" & Chr(10) & "&A"
        .RightFooter = "&8&D" & Chr(10) & "Page &P/&N"
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 75
        .PrintErrors = xlPrintErrorsDisplayed
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "temps" & Timer - temps
    
End Sub

pijaku · Answer

Bonjour,

Il s'agit d'un doublon.
Merci de continuer sur le sujet initial :
https://forums.commentcamarche.net/forum/affich-31543273-ameliorer-la-rapidite-d-execution

Améliorer la rapidité d'exécution

2 réponses

Discussions similaires

Newsletters