Barre de progression

Résolu/Fermé
ClaudeH - 7 févr. 2019 à 07:29
 ClaudeH - 7 févr. 2019 à 08:26
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

2 réponses

M-12 Messages postés 1333 Date d'inscription lundi 22 septembre 2008 Statut Membre Dernière intervention 8 avril 2023 299
7 févr. 2019 à 08:14
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
0
Merci beaucoup,
Cela répond exactement à ma demande,
Bonne journée
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
Modifié le 7 févr. 2019 à 08:24
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
0