Autres [RESOLU] Application.ScreenUpdating = False

[un internaute]

Bonjour le forum
Dans les macros ci-dessous quelqu'un peut-il me placer au bon endroit

Application.ScreenUpdating = False

J'ai toujours du mal où le placer
Merci à vous
Cordialement

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

    Application.EnableEvents = False
    ' 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

 

[chris]

Multipost

Les Application.ScreenUpdating = False & True sont-ils au bon endroit?

Comme dit dans le titre Merci pour vos éventuels retours...

forum.excel-pratique.com

 

[sylvanu]

Bonjour Un internaute,
Application.ScreenUpdating = False permet de figer l'écran pour accélérer les macros qui accèdent aux cellules, et par souci esthétique.
On le ré active avec Application.ScreenUpdating = True.
Donc il n'a pas de place précise par définition, tout dépend ce que vous voulez comme résultat.
Si vous voulez figer l'écran pendant toute la macro, alors vous faites votre Application.ScreenUpdating = False juste après le sub, au tout début.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
...
...
Application.ScreenUpdating = True
End Sub

Le Application.ScreenUpdating = True, peut être omis car il est remis à True en sortant, bien que MS demande de le mettre.

 

[un internaute]

Bonjour sylvanu
Je veux que ça accelere l'ouverture de mes onglets
Merci de ta reponse

 

[un internaute]

Bon jour sylvanu
Merci pour ta réponse
Bonne fin de WE