XL 2016 macro et feuille protégé

tuti

XLDnaute Occasionnel
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


VB:
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
 
Solution
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 :

VB:
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...

Oneida

XLDnaute Impliqué
Bonjour a tous
Sans deproteger
VB:
'code de protection feuille sans avoir a deproteger pour ecrire dans les cellules
Private Sub Workbook_Open()
    For n = 1 To Worksheets.Count
        With Worksheets(n)
            .EnableAutoFilter = True        'pas de filtre
            .Protect Password:="toto", DrawingObjects:=True, Contents:=True, Scenarios:=True, userInterfaceOnly:=True
            .EnableSelection = xlNoSelection        'pas de selection cellule
        End With
    Next n
End Sub
 

tuti

XLDnaute Occasionnel
@sylvanu
je ne connais pas la structure que dois avoir une macro
comment je dois l'intégrer à la macro ?

aussi, la macro peux agir sur , potentiellement, 90 onglets
à nommer FEUIL1, ne risque t'il pas d'avoir un probleme sur les autres onglets ?

@Oneida
idem, je ne connais pas le code, je ne sais pas comment l'intégrer à la macro
comment écrire ta réponse à la macro existante ?
 

laurent950

XLDnaute Barbatruc
Bonjour @tuti

si je comprend ce serait comme cela : Feuille "Synthese" (Déprotéger/Protéger) !
With targetSheet ' Feuille "Synthese" (Déprotéger/Protéger) !
.Unprotect
[le code]
.Protect
End With

Qu'elle sont les feuilles qui sont protégées, poster votre fichier Excel avec les feuilles protégés pour comprendre.

VB:
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
    .Unprotect
        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
    .Protect
    End With
End Sub
 
Dernière édition:

tuti

XLDnaute Occasionnel
pour la création, je n'ai que 1 onglet
( DATA et TDC ne comptant pas dans la quantité d'onglet )
mais l'onglet 01 pourras être dupliquer plein de fois

1 onglet par evenement/probleme
et sur une année, il peux y avoir plein de probleme
donc je partais sur une base possible de 100 onglet/dossier pour 1 année


ne sachant pas comment travailler le code, j'avais un peu la flemme de chercher à déverrouiller pile la cellule que le code utilisais
la raison de demander un bout qui déverrouille le temps de faire sa recap et de reverouille derrière de manière incoginto


edit :
sur cette version, j'ai toujours le bug à la même ligne
VB:
                ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
 

Pièces jointes

  • Suivi DI Evenement forum.xlsm
    58.9 KB · Affichages: 5
Dernière édition:

tuti

XLDnaute Occasionnel
voici le popup de mon côtè

1727626597118.png





1727626621112.png


le plus souvent, la même ligne est signalé en jaune
 

Phil69970

XLDnaute Barbatruc
Bonjour à tous

Perso quand je lis ceci je me pose des questions

je partais sur une base possible de 100 onglet/dossier pour 1 année

Et combien d'onglet tu peux lire en même temps ? 🤔
A mon avis 1 seul ... ;)

Et qu'est ce qu'il y a dans 90% de tes onglets ? :rolleyes:
La feuille de Pierre puis celle de Paul ou de Jacques etc ..... ou similaire en clair l'ossature est surement identique dans un grand nombre d'onglet et simplement quelque valeur qui change. :rolleyes:

Bonne lecture
 

laurent950

XLDnaute Barbatruc
Bonjour @tuti

Pour mieux comprendre l'origine de l'erreur, je vous invite à prendre une capture d'écran de la fenêtre (popup) qui s'affichera avec le message d'erreur (la "Msgbox" = Popup).

le plus souvent, la même ligne est signalé en jaune

Ajout : Gestion d'erreurs et identifications (VBA ci-dessous)
Cette capture d'écran me permettra de voir précisément où et comment l'erreur se produit, ainsi que le message d'erreur détaillé qui y figure. Merci de me l'envoyer dès que possible afin que je puisse vous aider à résoudre ce problème efficacement.

VB:
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
    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
                .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°"
       
                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
   
    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
 

laurent950

XLDnaute Barbatruc
Bonjour @Phil69970

il faut commencer sur cette discussion pour comprendre ici qui est une suite d'une demande :
https://excel-downloads.com/threads/synthese-renvoi-dinfo-sur-un-onglet.20084539/post-20660231

Et combien d'onglet tu peux lire en même temps ? 🤔
A mon avis 1 seul ... ;)

Et qu'est ce qu'il y a dans 90% de tes onglets ? :rolleyes:
La feuille de Pierre puis celle de Paul ou de Jacques etc ..... ou similaire en clair l'ossature est surement identique dans un grand nombre d'onglet et simplement quelque valeur qui change. :rolleyes:
 

laurent950

XLDnaute Barbatruc
Faite un essaie @tuti

la raison de demander un bout qui déverrouille le temps de faire sa recap et de déverrouille derrière de manière incognito
soit

Code:
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
    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
    
    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
 
Dernière édition:

tuti

XLDnaute Occasionnel
merci
je n'ai plus le message d'erreur

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


point 2 :
j'ai l'impression d'avoir vu quelque chose sur l'actualisation d'info si il y a déjà des infos dans le tableau
mais j'ai l'impression que cela a disparu avec cette version de la macro






@Phil69970
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
 

Discussions similaires

Statistiques des forums

Discussions
314 051
Messages
2 105 058
Membres
109 243
dernier inscrit
Erdnael