XL 2016 rafraîchir écran

KTM

XLDnaute Impliqué
Bonjour chers tous
Depuis mon userform je dois exécuter des macros dans mon classeur.
Mais il se trouve que lors de l'exécution il arrive que mon userform disparait souvent ou devienne tout blanc ; ce qui n'est pas agréable a voir à l'écran.
Mes macros sont souvent longues et souvent imbriquées les unes dans les autres.
Il m'a été Recommander d'utiliser les instructions comme :
-Application.ScreenUpdating = False
-DoEvents
-Userform.Repaint

Mais sais si je ne les utilise pas correctement mais le problème demeure.
Voici une de mes macros avec l'usage de ' Application.ScreenUpdating = False et ' Userform.Repaint
J'ai besoins besoins encore d'instructions . Merci
VB:
Private Sub Valider_RMD_Click()

    If Not IsDate(TextBox37) Then
        CreateObject("Wscript.shell").Popup "  Date au Format Incorrect , Veuillez Corriger !!  ", 1, , 64
        TextBox37 = ""
        TextBox37.SetFocus
        Exit Sub
    End If
    Sheets("TB").Unprotect "2580"
    [TB!D7] = ""
            With Sheets("Rapport_Mensuel_Dispensation")
            .Unprotect "2580"
            .Cells(7, 9) = CDate([TB!B11])
            .Cells(7, 9).NumberFormat = "mmmm-yyyy"
            .Cells(5, 9) = CDate(TextBox37.Value)
            End With
            Unload UserForm2
Accueil.RMDI.BackColor = &HFF&
Accueil.RMDI.Caption = "En Cours...."
Application.Wait (Now + TimeValue("00:00:01"))
Application.ScreenUpdating = True
Sheets("TB").Unprotect "2580"
Application.ScreenUpdating = False

            Sheets("RMDF").Unprotect "2580"
            Sheets("RDV").Unprotect "2580"
            Sheets("VA").Unprotect "2580"
            Sheets("AutresInfos").Unprotect "2580"
            Sheets("Fichier_Intermediaire").Unprotect "2580"
            Application.ScreenUpdating = False
    If Sheets("RDV").Range("A" & Rows.Count).End(xlUp).Row > 1 Then Sheets("RDV").Range("A4:J" & Sheets("RDV").Range("A" & Rows.Count).End(xlUp).Row + 1).Delete xlShiftUp
    Application.ScreenUpdating = False
    If Sheets("Fichier_Intermediaire").UsedRange.Rows.Count > 1 Then Sheets("Fichier_Intermediaire").Range("A2:DM" & Sheets("Fichier_Intermediaire").UsedRange.Rows.Count + 1).Delete xlShiftUp
    Application.ScreenUpdating = False
    If Sheets("AutresInfos").Range("A" & Rows.Count).End(xlUp).Row > 1 Then Sheets("AutresInfos").Range("M2:W" & Sheets("AutresInfos").UsedRange.Rows.Count + 1).Delete xlShiftUp
            
                        dl = Sheets("Grille_de_Dispensation").Range("A" & Rows.Count).End(xlUp).Row
                  Application.ScreenUpdating = False
                            If dl > 1 Then Application.ScreenUpdating = False: Call Generer_Fichier_Intermediaire
                            Accueil.Repaint
Sheets("VA1").Unprotect "2580"
Application.ScreenUpdating = False
Sheets("VA1").Range("A2:Z" & Sheets("VA1").UsedRange.Rows.Count + 1).Delete xlShiftUp
Sheets("Prophylaxie1").Unprotect "2580"
Application.ScreenUpdating = False
Sheets("Prophylaxie1").Range("A2:T" & Sheets("Prophylaxie1").UsedRange.Rows.Count + 1).Delete xlShiftUp

                            
                            If Sheets("Prophylaxie").Range("A" & Rows.Count).End(xlUp).Row > 1 Then Application.ScreenUpdating = False: Call Generer_Prophy
                            Accueil.Repaint
                            If Sheets("VA").Range("A" & Rows.Count).End(xlUp).Row > 1 Then Application.ScreenUpdating = False: Call Generer_Fichier_IntermediaireVA
                            Accueil.Repaint
                            If Sheets("AutresInfos").Range("A" & Rows.Count).End(xlUp).Row > 1 Then Application.ScreenUpdating = False: Call Generer_Autres_Infos
                    Application.ScreenUpdating = False
                   Call pdv_attrition
                   Accueil.Repaint
                            Application.ScreenUpdating = False

                            Sheets("RMDF").Visible = True
                            
                             Dim chemin As String
                            Dim fichier As String
                            Dim F As Worksheet
                            chemin = ThisWorkbook.Path & "\RMD_MMS\"
                            If Dir(chemin, vbDirectory) = "" Then MkDir chemin
                        
                        fichier = Month([TB!B11]) & "_" & "RMD" & "_" & Sheets("TB").Range("B8") & "_" & Format([TB!B11], "mmmm yyyy")
                     Application.ScreenUpdating = False
                Application.DisplayAlerts = False
     Application.ScreenUpdating = False
    Set F = ActiveWorkbook.Worksheets("RMDF")
    With F
        .Visible = True
        .Unprotect "2580"
        .UsedRange.Copy
    End With
 Application.ScreenUpdating = False
 
    Application.EnableEvents = False
    Workbooks.Add (xlWBATWorksheet)
    Application.EnableEvents = True
    With ActiveWorkbook
    Application.ScreenUpdating = False
        With .Worksheets(1).Cells(1)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
        Application.CutCopyMode = False
        ActiveWindow.DisplayGridlines = False
        Application.ScreenUpdating = False
                    With .Sheets(1)
                    Application.ScreenUpdating = False
                          With Intersect(.[V11:V72], .UsedRange.EntireRow)
                               For i = .Count To 1 Step -1
                                   If .Cells(i) = 0 Then .Cells(i).EntireRow.Delete
                               Next i
                          End With
                    .[V10:V72] = ""
                    End With
                    Application.ScreenUpdating = False
                     Application.DisplayAlerts = False
                .SaveAs chemin & fichier, 51 'format .xlsx
                .Close
                End With
                 Set F = Nothing
                 Accueil.Repaint
                 Application.ScreenUpdating = False
                    Sheets("TB").Range("A30").Value = 1
End Sub
 

Statistiques des forums

Discussions
312 104
Messages
2 085 332
Membres
102 864
dernier inscrit
abderrashmaen