Enlever ou mettre la protection sur des feuilles xls [Résolu]

Signaler
Messages postés
61
Date d'inscription
vendredi 9 novembre 2007
Statut
Membre
Dernière intervention
28 octobre 2011
-
cs_Le Pivert
Messages postés
6491
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 janvier 2020
-
Bonjour,

Je me suis fait une petite procédure qui enlève ou met la protection sur des feuilles de classeurs.
Mon seul problème, c'est la lenteur de la procédure qui ouvre les fichiers, prends toutes les feuilles une à une, referme le classeur et prends le suivant.
Globalment, la pocédure réalise plus rapidemment ce que je ferais à la main.
C'est bien, mais j'aimerais plus !
Puis je réaliser la même chose plus rapidemment : peut-être sans ouvrir toutes les feuilles.

Voici mon code actuelle :

Sub MdP()

1°) Je récupère l'adresse des fichiers :
Sheets("MdP").Select
i = 1
While Range("B" & i) <> ""
chemin = Range("B" & i)

2°) j'ouvre le fichier et toutes ces feuilles
Workbooks.Open Filename:=chemin
For k = 1 To 53
Sheets(k).Select
ActiveSheet.Protect Password:=("xxx"),
DrawingObjects:=True, Contents:=True, _
Scenarios:=True
Next

3°) je sauvegarde et ferme
ActiveWindow.Close SaveChanges:=True

4°) et suivante ....
i = i + 1
Sheets("MdP").Select
Wend
End Sub

Merci de vos réponses

5 réponses

Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Salut,

pour accelerer l'execution il est déjà préférable d'éviter les "select"

Sub MdP()
    Dim Feuille As Worksheet, MonFichier As Workbook
    'on désactive la mise à jour de l'affichage pour gagner un peu de temps
    Application.ScreenUpdating = False
    i = 1
    Do While Sheets("MdP").Range("B" & i).Value <> ""
        chemin = Sheets("MdP").Range("B" & i).Value
        
        'ici on met le fichier dans une variable(MonFichier) au moment de son ouverture
        Set MonFichier = Workbooks.Open(Filename:=chemin)
        ' puis pour chaque feuille de monfichier
        For Each Feuille In MonFichier.Worksheets 'cette methode a un autre avantage qui qu'elle est independante du nombre de feuille
            Feuille.Protect Password:=("xxx"), DrawingObjects:=True, Contents:=True, _
            Scenarios:=True
        Next
        'on ferme monfichier
        MonFichier.Close SaveChanges:=True
        i = i + 1
    Loop
    Application.ScreenUpdating = True
End Sub


A+
Messages postés
6491
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 janvier 2020
92
Bonjour,

J'ai trouvé cela sur le site:
'http://frederic.sigonneau.free.fr/

'protéger toutes les feuilles d'un classeur
Sub protege()
  Application.ScreenUpdating = False
  For i = 1 To Sheets.Count
    Sheets(i).Activate
    Range("A1").Select
    ActiveSheet.Protect Password:="zaza"
  Next i
  Sheets(1).Activate
  Range("A1").Select
  Application.ScreenUpdating = True
End Sub

'déprotéger toutes les feuilles d'un classeur
Sub deprotege()
  Application.ScreenUpdating = False
  For i = 1 To Sheets.Count
    Sheets(i).Activate
    Range("A1").Select
    ActiveSheet.Unprotect Password:="zaza"
  Next i
  Sheets(1).Activate
  Range("A1").Select
  Application.ScreenUpdating = True
End Sub


Si ça peut faire ton bonheur
@+
Messages postés
1
Date d'inscription
mardi 18 mai 2010
Statut
Membre
Dernière intervention
18 mai 2010

[^^happy13]
Messages postés
61
Date d'inscription
vendredi 9 novembre 2007
Statut
Membre
Dernière intervention
28 octobre 2011

OK, super, j'ai gagner un bon peu.
Et surtout le code me semble plus "solide".
C'est peut-être la limite de VBA, ouvrir les feuilles pour les manipuler.
Pas de possibilité de travailler en "sous couche" : on manipule sans ouvrir !

Merci à tous deux.

zeps
Messages postés
6491
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 janvier 2020
92
J'ai fait l'essai avec les 2 méthodes, il n'y a pas photo celle de bigfish_le_vrai est nettement plus rapide on voit les classeurs défilés dans la barre de tâche.
On en apprend tout les jours.
@+