XL 2016 VBA - Une manière rapide de trouver les cellules verrouillées ?

Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,
Je n'y crois pas trop, mais à part parcourir les cellules une à une (ce qui n'est envisageable que sur un Range limité) y a-t-il un moyen de trouver le Range des cellules verrouillées d'une feuille ?
Merci.
 
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,

C'est une des premières choses que j'avais regardées:
learn.microsoft.com

Énumération XlCellType (Excel)

Rubrique de référence sur Office VBA
learn.microsoft.com

Hélas, pas de miracle. Au moins sur mon Office 2016.
1715054564737.png
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,
Si si, on a vu.
A la suite de nombreux essais j'avais tiré des leçons de cette expérience personnelle des Noms du Gestionnaire de nom VBA.
excel-downloads.com

XL 2016 - VBA - Une manière rapide de trouver les cellules verrouillées ?

Bonjour, Je n'y crois pas trop, mais à part parcourir les cellules une à une (ce qui n'est envisageable que sur un Range limité) y a-t-il un moyen de trouver le Range des cellules verrouillées d'une feuille ? Merci.
excel-downloads.com excel-downloads.com
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonsoir @Dudu2, Le Forum
Avec l'objet Dictionnary
Je pense que l'outil de recherche est remplacé par Ctrl + F (la boîte n'est pas disponible en VBA).
J'ai comme l'impression que cet outil effectue également une boucle en arrière-plan.
Pour reproduire ce que fait cet outil, ce serait cela :
chercher toutes les cellules verrouillées, vides ou non.
Essayez avec votre fichier @Dudu2 en Poste #129
puis Essayez avec le fichier de @mapomme en poste #35.
Merci au forum, c'est un bon exercice."

VB: 
Sub testDictionnary()
  Dim dict As Object
  Set dict = CreateObject("Scripting.Dictionary")
  Dim rngFound As Range
  Dim rgn As Range
 
  Application.ScreenUpdating = False
  Application.FindFormat.Locked = True
  Application.FindFormat.FormulaHidden = False
 
' Boucle tant que pour rechercher toutes les cellules correspondantes
        Do
            ' Recherche les cellules répondant aux conditions spécifiées
                Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
      
            ' Si une cellule correspondante est trouvée, l'activer
                If Not rngFound Is Nothing Then
                    ' Ajoute la première cellule trouvée à la collection
                        rngFound.Activate
                        If dict.Exists(CStr(rngFound.Address)) Then
                            Exit Do
                        Else
                            dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
                            If rgn Is Nothing Then
                                Set rgn = rngFound
                            Else
                                Set rgn = Union(rgn, rngFound)
                            End If
                        End If
            End If
        Loop While Not rngFound Is Nothing
Application.ScreenUpdating = True
' Selection
    rgn.Select
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonsoir @Dudu2, Le Forum
Avec l'objet Collection
Je pense que l'outil de recherche est remplacé par Ctrl + F (la boîte n'est pas disponible en VBA).
J'ai comme l'impression que cet outil effectue également une boucle en arrière-plan.
Pour reproduire ce que fait cet outil, ce serait cela :
chercher toutes les cellules verrouillées, vides ou non.
Essayez avec votre fichier @Dudu2 en Poste #129
puis Essayez avec le fichier de @mapomme en poste #35.
Merci au forum, c'est un bon exercice."

VB: 
Sub testCollection()
    Dim col As New Collection
    Dim rngFound As Range
    Dim rgn As Range
  
    Application.ScreenUpdating = False
    Application.FindFormat.Locked = True
    Application.FindFormat.FormulaHidden = False
  
' Boucle tant que pour rechercher toutes les cellules correspondantes
        Do
            ' Recherche les cellules répondant aux conditions spécifiées
                Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
          
            ' Si une cellule correspondante est trouvée, l'activer
                If Not rngFound Is Nothing Then
                    ' Ajoute la première cellule trouvée à la collection
                        rngFound.Activate
                        If Exists(col, CStr(rngFound.Address)) Then
                            Exit Do
                        Else
                            col.Add key:=CStr(rngFound.Address), Item:=rngFound
                            If rgn Is Nothing Then
                                Set rgn = rngFound
                            Else
                                Set rgn = Union(rgn, rngFound)
                            End If
                        End If
            End If
        Loop While Not rngFound Is Nothing
'
    Application.ScreenUpdating = True
' Selection
    rgn.Select
End Sub

Function Exists(ByRef col As Collection, ByVal key As String) As Boolean
' Le code suivant vérifie si une clé existe
    On Error GoTo EH
    IsObject (col.Item(key))
    Exists = True
EH:
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
il me semble que ça éclaire et donne la solution à ton pb sur le . Delete évoqué ensuite
Cliquez pour agrandir...
En effet.
La solution c'est d'éviter d'avoir des noms du gestionnaire de noms qui soient identiques sur l'étendue classeur et sur l'étendue feuille. Sinon il n'y a aucun problème à créer des noms d'étendue classeur.
D'ailleurs, pour une application, dans un premier temps, j'en avais créé préfixés par le CodeName de la feuille ne sachant pas bien que je pouvais en limiter l'étendue à la feuille, et ça marchait très bien.
 
Dernière édition:
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
@laurent950,
Je ne saisis pas trop ce que fait ce code, n'étant pas familier du Search.
Mais il me semble qu'il cherche à l'endroit où se trouvent des données.
Or les cellules verrouillées (ou pas) le sont indépendamment de la présence de données.
Je te l'avais déjà signalé à ton 1er post.

De plus je vois du Range.Address. Il faut savoir que le .Address est limité à 255 caractères;
Je ne sais pas si c'est un problème ou pas ici mais...

Si je lance le code sur une feuille vide, ça plante car le rgn est Nothing.
Si je valorise une cellule Excel mouline sans s'arrêter. Je dois le tuer.
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Re @Dudu2

il cherche à l'endroit où se trouvent les cellules verrouillées uniquement et indépendamment de la présence de données.

Si je lance le code sur une feuille vide, ça plante car le rgn est Nothing.
Prise en compte ici
' Selection
On Error Resume Next
rgn.Select
If Err.Number <> 0 Then Err.Clear

je pense que maintenant c'est correcte

VB: 
Option Explicit
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Sub testDictionnary()
  Dim StartTime As Double
  Dim EndTime As Double
  Dim ElapsedTime As Double
  ' Début du comptage du temps
    StartTime = GetTickCount / 1000 ' Convertir les millisecondes en secondes
' **********************************
  Dim dict As Object
  Set dict = CreateObject("Scripting.Dictionary")
  Dim rngFound As Range
  Dim rgn As Range
 
  Application.ScreenUpdating = False
  Application.FindFormat.Locked = True
  Application.FindFormat.FormulaHidden = False
 
' Boucle tant que pour rechercher toutes les cellules correspondantes
        Do
            ' Recherche les cellules répondant aux conditions spécifiées
                Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
      
            ' Si une cellule correspondante est trouvée, l'activer
                If Not rngFound Is Nothing Then
                    ' Ajoute la première cellule trouvée à la collection
                        rngFound.Activate
                        If dict.Exists(CStr(rngFound.Address)) Then
                            Exit Do
                        Else
                            dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
                            If rgn Is Nothing Then
                                Set rgn = rngFound
                            Else
                                Set rgn = Union(rgn, rngFound)
                            End If
                        End If
            End If
        Loop While Not rngFound Is Nothing
Application.ScreenUpdating = True
' Selection
On Error Resume Next
    rgn.Select
    If Err.Number <> 0 Then Err.Clear
' *******************************
' Fin du comptage du temps
    EndTime = GetTickCount / 1000 ' Convertir les millisecondes en secondes
' Calcul du temps écoulé
    ElapsedTime = EndTime - StartTime
' Affichage du temps écoulé
    MsgBox "Temps écoulé : " & ElapsedTime & " secondes", vbInformation
End Sub
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
Ton code fonctionne bien pour un petit nombre de cellules verrouillées. Et c'est déjà un exploit.
Par contre, s'il y a une colonne verrouillée, ça mouline... S'il y en a plusieurs...
Je suppose que le Search trouve les cellules une à une et ensuite il y a une Union. Alors évidemment !
C'est pareil que de parcourir les cellules sauf que le Search trouve la 1ère.
 
Dernière édition:
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Dudu2 à dit:
Comment fais-tu avec Ctrl + F pour trouver la(es) plage(s) de cellules verrouillées ?
Cliquez pour agrandir...
Au départ :
Ces deux lignes de code sont utilisées pour spécifier les paramètres de recherche lors de l'utilisation de la méthode Find dans VBA.
  1. Application.FindFormat.Locked = True : Cette ligne indique à Excel de rechercher uniquement dans les cellules verrouillées lors de l'utilisation de la méthode Find. Cela signifie que seules les cellules verrouillées seront prises en compte lors de la recherche.
  2. Application.FindFormat.FormulaHidden = False : Cette ligne spécifie que la recherche ne doit pas ignorer les cellules dont les formules sont masquées. Par défaut, Excel masque les cellules contenant des formules qui renvoient une valeur vide. En définissant cette propriété sur False, la recherche inclura également les cellules dont les formules sont masquée

ensuite
Ces lignes de code représentent une boucle qui recherche et traite toutes les cellules correspondantes dans la feuille active en fonction des critères spécifiés. Voici une explication détaillée :
Code: 
' Boucle tant que pour rechercher toutes les cellules correspondantes
        Do
            ' Recherche les cellules répondant aux conditions spécifiées
                Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
      
            ' Si une cellule correspondante est trouvée, l'activer
                If Not rngFound Is Nothing Then
                    ' Ajoute la première cellule trouvée à la collection
                        rngFound.Activate
                        If dict.Exists(CStr(rngFound.Address)) Then
                            Exit Do
                        Else
                            dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
                            If rgn Is Nothing Then
                                Set rgn = rngFound
                            Else
                                Set rgn = Union(rgn, rngFound)
                            End If
                        End If
            End If
        Loop While Not rngFound Is Nothing
  1. Boucle Do While : La boucle Do est utilisée pour répéter le processus de recherche jusqu'à ce qu'aucune cellule correspondante ne soit trouvée. La condition de la boucle est Loop While Not rngFound Is Nothing, ce qui signifie que la boucle se poursuivra tant qu'une cellule correspondante (rngFound) n'est pas Nothing, c'est-à-dire tant qu'une cellule n'a pas été trouvée.
  2. Recherche de cellules correspondantes : À chaque itération de la boucle, la méthode Find est utilisée pour rechercher la prochaine cellule vide (What:="") dans la feuille active (Cells) en commençant après la cellule active (After:=ActiveCell). Les autres paramètres spécifient les options de recherche, telles que la recherche dans les formules (LookIn:=xlFormulas), la recherche partielle (LookAt:=xlPart), etc.
  3. Activation de la cellule trouvée : Si une cellule correspondante est trouvée (c'est-à-dire si rngFound n'est pas Nothing), cette cellule est activée (rngFound.Activate) pour la traiter.
  4. Traitement de la cellule trouvée : La cellule trouvée est ensuite ajoutée à un dictionnaire (dict) pour enregistrer son adresse. Si cette adresse n'existe pas déjà dans le dictionnaire, la cellule est ajoutée au dictionnaire et à une plage de cellules (rgn) qui sera ultérieurement sélectionnée. Si l'adresse existe déjà dans le dictionnaire, la boucle est interrompue (Exit Do) car toutes les cellules correspondantes ont déjà été traitées.
  5. Fin de la boucle : Une fois que toutes les cellules correspondantes ont été traitées, la boucle se termine lorsque la variable rngFound est Nothing, c'est-à-dire qu'aucune cellule correspondante n'a été trouvée dans la feuille active.
Ensuite :
ces lignes de code :
VB: 
' Selection
On Error Resume Next
    rgn.Select
    MsgBox rgn.Address
    If Err.Number <> 0 Then Err.Clear
  1. Sélection de la plage de cellules : Cette partie du code sélectionne la plage de cellules rgn qui a été construite pendant la boucle de recherche. La ligne rgn.Select est utilisée pour sélectionner cette plage de cellules.
  2. Gestion des erreurs : La directive On Error Resume Next est utilisée pour indiquer à VBA de continuer l'exécution du code même s'il y a une erreur. Cela signifie que si une erreur survient lors de la sélection de la plage de cellules, elle sera ignorée et le code continuera à s'exécuter. Cela est suivi par la ligne rgn.Select, qui tente de sélectionner la plage de cellules rgn.
  3. Affichage de l'adresse de la plage de cellules : La ligne MsgBox rgn.Address affiche l'adresse de la plage de cellules rgn dans une boîte de message. Cela vous permet de vérifier visuellement si la plage de cellules sélectionnée est correcte.
  4. Gestion des erreurs (suite) : La ligne suivante, If Err.Number <> 0 Then Err.Clear, vérifie s'il y a eu une erreur lors de la sélection de la plage de cellules. Si une erreur est détectée (c'est-à-dire si Err.Number est différent de zéro), la méthode Err.Clear est utilisée pour effacer l'erreur et permettre à l'exécution du code de continuer sans interruption.
 
Vote positif 0 Vote négatif

Discussions similaires

K
  • Question
XL 2021 Mettre un message d'erreur si les cellules ne sont pas verrouillées
2
Réponses
18
Affichages
741
krolik serge
K
M
  • Question
Microsoft 365 Pb de formules qui se modifient dans des cellules verrouillées
Réponses
14
Affichages
573
TooFatBoy
TooFatBoy
T
  • Question
Microsoft 365 Cellules verrouillées si une est nonvide
Réponses
2
Affichages
413
Yves P
Y
A
  • Résolu(e)
Microsoft 365 Suppression d'une ligne d'un tableau avec une macro
Réponses
13
Affichages
721
Alain 79
A
F
  • Question
XL 2019 VBA et Power Query - Barre de progression
Réponses
10
Affichages
343
crocrocro
C
C
  • Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
349
gbinforme
G
K
  • Question
Microsoft 365 création mot passe classique avec un code
Réponses
1
Affichages
266
Gégé-45550
Gégé-45550
C
  • Résolu(e)
XL 2016 Infos-bulle dans la Barre d'Outils "Accès Rapide"
Réponses
7
Affichages
152
crocrocro
C
A
  • Question
XL 2021 Cellules Excel : Basculer de cellules référencées en A1 à cellules identifiées par noms
Réponses
5
Affichages
474
Astyanax
A
D
  • Question
XL 2019 Effacement de données ciblées (remise à zéro)
Réponses
14
Affichages
548
didcac
D

Membres actuellement en ligne

1 membres et 31 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 124
Messages
2 116 472
Membres
112 753
dernier inscrit
PUARAI29