XL 2016 macro et feuille protégé

[tuti]

bonjour,
suite au sujet sur la compilation des infos par une macro,
j'ai remarqué que celle ci semblait fonctionner correctement ( pas fait encore les test avec plusisuers dizaine d'onglet )

aussi, j'ai remarquer un "bug" quand la feuille est protégé
j'ai remarquer qu'il exisster des sujets similaires

ma feuille étant protégé mais sans mdp

est il possible d'adapter la macro pour bypass la protection de celle ci ?
attention, elle doit remettre la protection à la fin de l'action

Sub ExtraireNomsEtValeurs()
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("Synthese")
 
    Dim lastRow As Long
    lastRow = 3 ' A adapter en fonction de la première ligne de départ.
 
    Dim ws As Worksheet
 
    ' Ajout :  j'ai bien vu l'emplacement pour ignorer les feuilles mais je ne sais pas comment le saisir
    Dim FeuillesIgnorées As Variant
    Dim FeuilleTrouvée As Boolean
    Dim i As Integer
 
    ' Liste des feuilles à ignorer
    FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD")
    ' Tu peux ajouter d'autres noms ici exemple :
    '                         FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD","Feuil5","Feuil9")
 
 
    With targetSheet
        For Each ws In ThisWorkbook.Worksheets
          
            FeuilleTrouvée = False
            ' Vérifie si la feuille est dans la liste des feuilles à ignorer
            For i = LBound(FeuillesIgnorées) To UBound(FeuillesIgnorées)
                If ws.Name = FeuillesIgnorées(i) Then
                    FeuilleTrouvée = True
                    Exit For
                End If
            Next i
          
            ' Si la feuille n'est pas à ignorer, traiter les données
            If Not FeuilleTrouvée Then
                .Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
                .Cells(lastRow, 2).Value = ws.Range("B2").Value ' ***
                .Cells(lastRow, 3).Value = ws.Range("B3").Value ' ***
                .Cells(lastRow, 4).Value = ws.Range("B4").Value ' ***
                .Cells(lastRow, 5).Value = ws.Range("B5").Value ' ***
                .Cells(lastRow, 6).Value = ws.Range("D2").Value ' ***
                .Cells(lastRow, 7).Value = ws.Range("D3").Value ' ***
                .Cells(lastRow, 8).Value = ws.Range("D4").Value ' ***
                .Cells(lastRow, 9).Value = ws.Range("D5").Value ' ***
                .Cells(lastRow, 10).Value = ws.Range("J3").Value ' ***
                .Cells(lastRow, 11).Value = ws.Range("L3").Value ' ***
                .Cells(lastRow, 12).Value = ws.Range("L5").Value ' ***
                .Cells(lastRow, 13).Value = ws.Range("J5").Value ' ***
                .Cells(lastRow, 14).Value = ws.Range("O2").Value ' ***
                .Cells(lastRow, 15).Value = ws.Range("O3").Value ' ***
                .Cells(lastRow, 16).Value = ws.Range("O4").Value ' ***
                .Cells(lastRow, 17).Value = ws.Range("O5").Value ' ***
                .Cells(lastRow, 18).Value = ws.Range("N6").Value ' ***
                .Cells(lastRow, 20).Value = ws.Range("E3").Value ' Intitulé rapide
                .Cells(lastRow, 21).Value = ws.Range("E5").Value ' Commentaire
                ' Création des liens
                .Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
                ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
              
                lastRow = lastRow + 1
            End If
        Next ws
    End With
End Sub

 

[laurent950]

Bonjour @tuti

point 1 :
par contre, j'ai un comportement bizarre si j'ai plus de 1 onglet ( 01 - 02 - 03 - ... )
quand je clique sur la macro, il rassemble les infos et bascule automatiquement sur un onglet
mais je n'ai pas compris si il bascule sur un onglet en particulier ou pas

ci-dessous :

Sub ExtraireNomsEtValeurs()
Application.ScreenUpdating = False
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("Synthese")
    
    Dim lastRow As Long
    lastRow = 3 ' A adapter en fonction de la première ligne de départ.
    
    Dim ws As Worksheet
    Dim FeuillesIgnorées As Variant
    Dim FeuilleTrouvée As Boolean
    Dim i As Integer
    Dim boucleCount As Long ' Compteur pour la boucle For Each
    
    ' Liste des feuilles à ignorer
    FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD")
    
    With targetSheet
        .Unprotect
        On Error GoTo GestionErreur ' Activation de la gestion d'erreur
        
        boucleCount = 0
        For Each ws In ThisWorkbook.Worksheets
            boucleCount = boucleCount + 1
            FeuilleTrouvée = False
            
            ' Vérifie si la feuille est dans la liste des feuilles à ignorer
            For i = LBound(FeuillesIgnorées) To UBound(FeuillesIgnorées)
                If ws.Name = FeuillesIgnorées(i) Then
                    FeuilleTrouvée = True
                    Exit For
                End If
            Next i
            
            ' Si la feuille n'est pas à ignorer, traiter les données
            If Not FeuilleTrouvée Then
                 ' Déprotection
                   ws.Unprotect
                  
                .Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
                .Cells(lastRow, 2).Value = ws.Range("B2").Value
                .Cells(lastRow, 3).Value = ws.Range("B3").Value
                .Cells(lastRow, 4).Value = ws.Range("B4").Value
                .Cells(lastRow, 5).Value = ws.Range("B5").Value
                .Cells(lastRow, 6).Value = ws.Range("D2").Value
                .Cells(lastRow, 7).Value = ws.Range("D3").Value
                .Cells(lastRow, 8).Value = ws.Range("D4").Value
                .Cells(lastRow, 9).Value = ws.Range("D5").Value
                .Cells(lastRow, 10).Value = ws.Range("J3").Value
                .Cells(lastRow, 11).Value = ws.Range("L3").Value
                .Cells(lastRow, 12).Value = ws.Range("L5").Value
                .Cells(lastRow, 13).Value = ws.Range("J5").Value
                .Cells(lastRow, 14).Value = ws.Range("O2").Value
                .Cells(lastRow, 15).Value = ws.Range("O3").Value
                .Cells(lastRow, 16).Value = ws.Range("O4").Value
                .Cells(lastRow, 17).Value = ws.Range("O5").Value
                .Cells(lastRow, 18).Value = ws.Range("N6").Value
                .Cells(lastRow, 20).Value = ws.Range("E3").Value
                .Cells(lastRow, 21).Value = ws.Range("E5").Value
                
                ' Création des liens
                .Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
                ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
                ' Protection
                ws.Protect
                
                lastRow = lastRow + 1
            End If
        Next ws
        .Protect
        On Error GoTo 0 ' Désactiver la gestion des erreurs après avoir terminé la boucle
    End With
    
    Application.ScreenUpdating = True
    targetSheet.Activate
    Exit Sub ' Quitter proprement avant la gestion des erreurs
    
GestionErreur:
    ' Capture l'erreur et affiche une MsgBox avec les détails
    MsgBox "Erreur n° " & Err.Number & vbCrLf & _
           "Description : " & Err.Description & vbCrLf & _
           "Feuille : " & ws.Name & vbCrLf & _
           "Itération de la boucle : " & boucleCount & vbCrLf & _
           "Ligne : " & Erl, vbCritical, "Erreur détectée"
    Resume Next ' Continue l'exécution après l'erreur pour la boucle suivante
End Sub

 

[Phil69970]

Re

@tuti

D'abord je reconnais que j'ai juste survolé le fil et n'y ai pas participé hormis pour dire qu'avoir 100 onglets me semble une hérésie cela donne un fichier surement énorme surtout si en plus tu as par exemple des MFC.

Perso :

Pour moi quand on a une ossature identique mais avec des valeurs différentes on crée un onglet ou 2 ou 3 onglets si nécessaire "Modèle" et tout dans une (voir plusieurs) BDD et selon les besoins on par du modèle pour créer l'onglet désiré.

Pour schématiser :

- 1 feuille sommaire ou index si besoin
- 1 feuille BDD (Base de données) toutes les infos se trouve la dedans
- 1 feuille modèle voir 2 ou 3 si besoin de plusieurs modèles différents
- 1 feuille problème c'est la feuille sélectionné qui ira chercher les infos dans la BDD en fonction du modèle et les affichera.
- 1 feuille paramètre

Donc au total il y a que 4 à 7/8 feuilles et non pas 100 feuilles qui sont inutiles car à un instant donné tu ne peux consulter qu'une seule feuille à la fois.

dans les métiers de l'immobilier, tu n'as pas qu'un probleme par an
mais une multitude qui s'amoncelle au cours de l'année
pour un site, l'onglet 1 peux parler de plomberie, le 2 de clim , le 3 d'elec
multiplier par 20 ou 30 sites
ce document ne me serviras pas pour faire des math/calcul mais du regroupement/compilation d'infos

Et pour reprendre ton post j'aurais vu les choses comme ceci :

1) Un onglet pour la BDD éventuellement il peut y avoir 2 voir 3 BDD
==> 1 pour les "infos du site" avec 1 identifiant par clé* unique par site qui aurait par exemple adresse, date de début d'achat, date dépôt de permis, nom des intervenants etc...
==> 1 pour tous les "problèmes" des différents sites relié à la clé d’identification de chaque site
Donc avec la clé d'identification du site X on a les infos du site dans une BDD "Infos" et les problèmes pour ce site X dans une 2eme BDD "Problèmes"

2) Un onglet pour sélectionner ce que tu veux afficher :
-Ex : Une cellule pour sélectionner le site X et une cellule éventuellement pour le thème (exemple je veux que les problèmes électrique ou de plomberie ou bien tous les problèmes du site X.....)
Et la macro affichera les onglets qui ont des problèmes donc 1 pour la plomberie, le 2 pour la clim , le 3 pour l’électricité...
Et si tu as 100 onglets (donc 100 problèmes) il faudrait mieux raser l'immeuble et/ou changer d'artisans !!!

Quand un problème a été résolu une coche permet de ne plus l'afficher mais il reste dans la BDD "problèmes" bien sur

Des que tu changes de site la macros supprime les onglets crées pour repartir avec un nouveau site etc....

Ce n'est que ma vision perso et surement parcellaire de ton fichier.

Bonne lecture et bonne continuation dans ton projet

*Un identifiant par clé c'est comme par exemple ton N° de SS

 

[tuti]

pour répondre à la suggestion de @Phil69970 ,
ta suggestion est très bonne pour faire une bdd
hors dans mon cas, je souhaite juste suivre les échanges par mails/téléphone/vocal ( va chercher pendant un comité de direction parmi une floppée de mail )
je sais que ton document, aussi soit ils, n'aurait pas été utilisé de manière optimal


-----------------------------------------------------------
concernant le sujet,
la macro vais correctement la demande ( pas de popup )

mais sur un point d'actualisation précis, j'ai constaté qu'il rechargeais les infos à chaque clique
hors il se peux ( j'ai pas chercher plus loin ), que les onglets soit supprimer pour reset les sujets ( nouvelle année par exemple )

si l'onglet est supprimer, les anciennes infos restes affichés dans la feuille de synthese
plutot que d'alourdir inutilement la macro, j'aurais aimer une petite macro annexe qui supprime les infos du tableau de la feuille synthese

attention dans la colonne S, j'ai intégrer une petite formule de convertion de jours en période ( année, mois jour ),
j'aimerais pas supprimer le contenu de la cellule

 

[laurent950]

Bonjour @tuti,

si l'onglet est supprimer, les anciennes infos restes affichés dans la feuille de synthese
plutot que d'alourdir inutilement la macro, j'aurais aimer une petite macro annexe qui supprime les infos du tableau de la feuille synthese

Je vous invite à créer une nouvelle demande pour traiter ce nouveau sujet, qui diffère de la discussion actuelle. Pour aller de l'avant, pourriez-vous d'abord valider la solution apportée dans cette discussion ?

concernant le sujet,
la macro vais correctement la demande ( pas de popup )

Et au même titre valider la solution dans ce poste avant de basculer sur la nouvelle discussion

Cordialement,