Barre de progression
Résolu
ClaudeH
-
ClaudeH -
ClaudeH -
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"
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
A voir également:
- Barre de progression
- Windows 11 barre des taches a gauche - Guide
- Barre de défilement - Guide
- Barré whatsapp - Guide
- Barre verticale mac - Forum MacOS
- Barre clavier - Forum Excel
2 réponses
Bonjour,
Au lieu d'une barre de progression qui va alourdir un peu plus
place cette ligne en début de macro
Cela évite le rafraîchissement de l'écran
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
Bonjour,
A priori pas besoin de barre de progresssion
une facon de faire:
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
Cela répond exactement à ma demande,
Bonne journée