Discussion :

[Un Internaute]

Bonjour le forum
Dans les macros quelqu'un peut-il me mettre Application.ScreenUpdating = False au bon endroit pour accélérer l'ouverture des onglets
Merci à vous
Cordialement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ActiveSheet.Range("A1").Select
End Sub
 
Private Sub Workbook_Open()
Dim wSheet As Worksheet
Dim Feuille As String, AMasquer As String
Dim I As Integer
 
  For Each wSheet In Worksheets
'    wSheet.Protect UserInterfaceOnly:=True
  Next wSheet
 
  Feuille = MonthName(Month(Date)) & " " & Year(Date)
  If FeuilleExiste(Feuille) = False Then Exit Sub
  If UCase(Feuille) <> UCase(ActiveSheet.Name) Then
      ' Teste le nom en majuscule de la feuille du mois en cours avec le nom en majuscule de la feuille affichée
    AMasquer = ActiveSheet.Name
    With Sheets(Feuille)
      .Visible = True
      .Select
    End With
    Sheets(AMasquer).Visible = xlSheetVeryHidden
  End If
 
  For I = 1 To Sheets.Count                                                                    'Pour afficher tous les Mois
    If UCase(Sheets(I).Name) <> UCase(Feuille) Then Sheets(I).Visible = xlSheetVeryHidden      'Pour afficher tous les Mois
  Next I                                                                                       'Pour afficher tous les Mois
  Range("A1").Select                                                                           ' Remet la sélection en A1 (Position normale) le 20/06/2021
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim LaDate As Date
Dim MoisSuivant As String
Dim sDate As String, ValDate As Variant
 
    ' On recherche si la page est surveillée
    If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
                Split(Sh.Name, " ")(0), vbTextCompare) Then
      ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
      NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
 
'      If Target.Row - 5 > Day(Date) Then      'En commentaires ces 4 lignes pour afficher ligne données dans feuille
'        Beep
'        MsgBox "PAS LE BON JOUR"
'      Else
 
        ' Surveille la plage du 1er au dernier jours du mois
        If Not Intersect(Range("B6:C" & 5 + NombreJour, "F6:G" & 5 + NombreJour), Target) Is Nothing Then
          ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
          LaDate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
          ' Si la colonne B et la colonne C est vide on efface la date
          Range("A" & Target.Row) = IIf(Range("B" & Target.Row) = "", "", Application.Proper(Format(LaDate, "dddd dd mmmm yyyy")))
          '
          If Range("B" & Target.Row) = "" Then Range("C" & Target.Row) = "": Range("E" & Target.Row) = ""
          '
          Range("F" & Target.Row) = IIf(Range("B" & Target.Row) = "", "", LaDate)
 
'          End If
          Target.Select
        End If
      End If
'    End If                                        'En commentaires cette ligne pour afficher ligne données dans feuille
  Application.EnableEvents = True
End Sub
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function
Sub ret()
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 Cancel = Not Cancel
  Select Case Target.Address
    Case "$A$3": If Not Target.Comment Is Nothing Then KilometrageDeDepart
    Case "$B$2"
      Columns("F:F").Hidden = Not Columns("F").Hidden
      Case "$G$1"
         UsfChoix.Show 0
    Case Else
  End Select
 
     If Not Intersect(Range("D3"), Target) Is Nothing Then
    Cancel = True
    TbCoul = Array(3, 5, 5, 5)
    Tb = Array("", "SP 95", "SP 98")
 
    'X = UCase(Trim(Target))   'Pour mettre en Majuscule
    X = (Trim(Target))
    If UBound(Filter(Tb, X)) >= 0 Then
      Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
        Target = Tb(Indice)
        Couleur = TbCoul(Indice)
        If Couleur = 0 Then
          Couleur = Target.Offset(0, -1).Interior.ColorIndex
        End If
        Target.Interior.ColorIndex = Couleur
    Else
        Target = ""
    End If
 
         ElseIf Not Intersect(Range("D2", "D4:D5"), Target) Is Nothing Then
    Cancel = True
    TbCoul = Array(3, 5, 5, 5)
    Tb = Array("", "Super U Labussière", "Super U Corgnac", "Leclerc Limoges")
 
    'X = UCase(Trim(Target))   'Pour mettre en Majuscule
    X = (Trim(Target))
    If UBound(Filter(Tb, X)) >= 0 Then
      Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
        Target = Tb(Indice)
        Couleur = TbCoul(Indice)
        If Couleur = 0 Then
          Couleur = Target.Offset(0, -1).Interior.ColorIndex
        End If
        Target.Interior.ColorIndex = Couleur
    Else
        Target = ""
    End If
End If
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim LaDate As Date, J As Long
  If Target.Address <> Selection.Address Then Exit Sub
    If Target.Column = 2 Then
        For J = 6 To 36
            If Cells(J, "B") = "" Then Cells(J, "A").ClearContents
        Next J
        ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
        LaDate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
        If UCase(MonthName(Month(LaDate))) = UCase(Split(Sh.Name, " ")(0)) Then
            ' Si la colonne B et la colonne C est vide on efface la date
            Range("A" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
        End If
    End If
End Sub

[Philippe Tulliez]

Bonjour,

Dans les macros quelqu'un peut-il me mettre Application.ScreenUpdating = False au bon endroit pour accélérer l'ouverture des onglets

En demandant aux contributeurs de ce site, tous bénévoles je le rappelle, de lire une centaine de lignes non indentées et de plus non insérées par les balises prévues à cet effet dans l'éditeur de message, voir image plus bas, vous expose à n'avoir que peu de réponse.

L'instruction Application.ScreenUpdating = False se place avant les instructions qui vont effectuer les traitements tels que l'ouverture de classeur, écriture dans des cellules, tris, etc.
Au passage, évitez entre-autres les méthodes Select, Activate qui ralentissent l'exécution de votre programme et ne servent en général à rien car il est possible de manipuler les objets sans y avoir recours.