Barre de progression Résolu/Fermé

Question

Bonjour, 
J'ai une boucle pour protéger et déprotéger des plages en fonction d'une date,... (voir ci-dessous)
Elle répond parfaitement à ma demande, mais je vois défiler toit le tableau (370 colonnes et 104 lignes) !
Existe-t-il un moyen d'empêcher ce défilement en le remplaçant par une barre de progression par exemple ?
D'avance merci et bonne journée,

If Cells(6, 3).Value <> Cells(7, 3).Value Then

    Sheets("Planning").Unprotect Password:="date"
    For i = 6 To 371
        If Cells(6, i).Value < Cells(6, 3).Value Then
            Range(Cells(8, i), Cells(16, i)).Select
            Selection.Locked = True
            Range(Cells(18, i), Cells(33, i)).Select
            Selection.Locked = True
            Range(Cells(35, i), Cells(44, i)).Select
            Selection.Locked = True
            Range(Cells(46, i), Cells(61, i)).Select
            Selection.Locked = True
            Range(Cells(63, i), Cells(70, i)).Select
            Selection.Locked = True
            Range(Cells(72, i), Cells(78, i)).Select
            Selection.Locked = True
            Range(Cells(80, i), Cells(99, i)).Select
            Selection.Locked = True
            Range(Cells(101, i), Cells(103, i)).Select
            Selection.Locked = True

                Else
            
            Range(Cells(8, i), Cells(16, i)).Select
            Selection.Locked = False
            Range(Cells(18, i), Cells(33, i)).Select
            Selection.Locked = False
            Range(Cells(35, i), Cells(44, i)).Select
            Selection.Locked = False
            Range(Cells(46, i), Cells(61, i)).Select
            Selection.Locked = False
            Range(Cells(63, i), Cells(70, i)).Select
            Selection.Locked = False
            Range(Cells(72, i), Cells(78, i)).Select
            Selection.Locked = False
            Range(Cells(80, i), Cells(99, i)).Select
            Selection.Locked = False
            Range(Cells(101, i), Cells(103, i)).Select
            Selection.Locked = False
        End If
    Next i
    Sheets("Planning").Range("C6").Copy
    Range("C7").PasteSpecial Paste:=xlPasteValues
End If

ActiveSheet.Protect "date"

Configuration: Windows / Chrome 71.0.3578.98

M-12 · Answer

Bonjour,

Au lieu d'une barre de progression qui va alourdir un peu plus
place cette ligne en début de macro

Application.ScreenUpdating = False
Cela évite le rafraîchissement de l'écran

f894009 · Answer

Bonjour,
A priori pas besoin de barre de progresssion 
une facon de faire:

Sub test()
    Dim Flg_Lock As Boolean
    If Cells(6, 3).Value <> Cells(7, 3).Value Then      'quelle feuille ???
        Application.ScreenUpdating = False      'stop rafraichissement feuille en cours
        With Sheets("Planning")
            .Unprotect Password:="date"
            For i = 6 To 371
                If .Cells(6, i).Value < .Cells(6, 3).Value Then
                    Flg_Lock = True
                Else
                    Flg_Lock = False
                End If
                .Range(Cells(8, i), Cells(16, i)).Locked = Flg_Lock
                .Range(Cells(18, i), Cells(33, i)).Locked = Flg_Lock
                .Range(Cells(35, i), Cells(44, i)).Locked = Flg_Lock
                .Range(Cells(46, i), Cells(61, i)).Locked = Flg_Lock
                .Range(Cells(63, i), Cells(70, i)).Locked = Flg_Lock
                .Range(Cells(72, i), Cells(78, i)).Locked = Flg_Lock
                .Range(Cells(80, i), Cells(99, i)).Locked = Flg_Lock
                .Range(Cells(101, i), Cells(103, i)).Locked = Flg_Lock
            Next i
            .Range("C6").Copy
            .Range("C7").PasteSpecial Paste:=xlPasteValues
            .Protect "date"
        End With
        MsgBox "Opreration terminee!!!!!!!"
    End If
    Application.ScreenUpdating = True
End Sub

Barre de progression

2 réponses

Discussions similaires