Discussion :

[nirvana4483]

je pense il faut réussir à l'intégrer dans le code de la macro Sub rempl_IMS que des membres m'ont fourni

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub rempl_IMS(arg) 'Remplissage automatique de l'onglet IMS de la semaine en cours + mise en forme conditionnelle des cellules
    Dim kR As Long, kC As Integer
    Application.ScreenUpdating = False
    With Worksheets("IMS_CW" & num_sem & "_" & annee)
       If arg <> "" Then
            Set rech_nom = Nothing
            Set rech_nom = .Range("A:A").Find(what:=nom_toolmoov & " " & pre_toolmoov, lookat:=xlWhole, MatchCase:=False)
            kR = rech_nom.Row
            Set rech_date = Nothing
            Set rech_date = .Range("13:13").Find(what:=aujourdhui, lookat:=xlWhole, MatchCase:=False)
            kC = rech_date.Column
            .Unprotect "admin"
            If .Cells(kR, kC) <> "" Then
                If .Cells(kR, kC + 3) <> "" Then           'les deux champs remplis on recommence
                   .Cells(kR, kC).Resize(1, 5) = ""  'on efface les 5 colonnes successives
                Else
                   kC = kC + 3
                End If
            End If
 
            If .Cells(kR, kC) <> "MAJ" Then
               '.Cells(kR, kC) = arg
               '.Cells(kR, kC) = arg & vbLf & Format(Time, "hh:mm")
               .Cells(kR, kC) = arg & vbLf & Format(Now, "dd/mm/yy hh\hnn")
            End If
            If arg = "MAJ" Then
                .Cells(kR, kC + 1) = ecart & " Kg " & vbLf & commentaire
            Else
                .Cells(kR, kC + 1) = ecart & " Kg"
            End If
        End If
        Autoremplissage kC, Worksheets("IMS_CW" & num_sem & "_" & annee)
        .Protect Password:="admin", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    End With
 
    ThisWorkbook.Save
    Application.ScreenUpdating = True
End Sub

j'ai testé d'y glisser un bout de code pour désactiver et activer le filtre avant de remplir l'onglet mais cela fonctionne pas
car la macro commence à rechercher le nom de le personne, du coup il faut réussir à supprimer le filtre avant

[rMist2024]

Probablement il faut place le code au lancement de l'opération juste après avoir retiré le mode passe dans le macro CommandButton21_Click , les deux macros pour l'activation et la désactivation du filtre sont placés dans des fonctions indépendantes (Retirer_Le_filtre , Placer_Le_filtre ) cela permet de les placer également dans d'autres endroits si nécessaire

dans le Module1 placer les deux marcos Retirer_Le_filtre et Placer_Le_filtre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function Retirer_Le_filtre()
 With Sheets("Template_IMS")
   Dim lastcolonne As Long
   lastcolonne = .Range("IV14").End(xlToLeft).Column
   .Range("A14").Resize(1, lastcolonne).AutoFilter
 End With
End Function
 
Function Placer_Le_filtre()
 Dim RgAddr As String
 With Sheets("Template_IMS")
   RgAddr = Split(.UsedRange.Address(False, False), ":")(1)
  .Range("A14:" & RgAddr).AutoFilter Field:=1, Criteria1:="*"
 End With
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub CommandButton21_Click() 'Bouton badger Caisse
 
unprot
 
Retirer_Le_filtre
 
masq_auto 'Masquage automatique des onglets "LOG" / "Bdd_badge" / "Bdd_Safran"
 
recherche_port
 
def_date 'Permet de connaitre la date en fonction de l'heure, Si avant 2h du matin date du jour -1, si après 2h matin date du jour
 
creat_IMS   'Creation de l'onglet IMS de la semaine en cours
 
badger_caisse 'Badgeage de la caisse + tare + recherche du numéro de caisse dans la bdd TOOLMOOV
 
MsgBox "Veuillez déposer la caisse sur le plateau de la balance" & vbCr & vbCr & "Puis appuyer sur la touche ENTER", vbOKOnly, "Action à effectuer"
 
pesee
 
comparaison
 
Placer_Le_filtre
 
prot
 
End Sub

[nirvana4483]

merci je vais regarder et tester cela la semaine prochaine

[nirvana4483]

Je n'ai pas encore eu le temps d'aller tester, car ceci n'est pas ma tâche principale

je ne suis pas sûr, je crois que cela va pas fonctionner car je souhaite retirer et remettre le filtre sur la sheet qui change de nom toutes les semaines exemple IMS_CW35_2024 et non la sheet Template_IMS


je souhaite retirer le filtre au début du processus de pesée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Rows("14:14").Select
    ActiveSheet.Unprotect

et remettre le filtre bien entre la colonne A14 et AQ14, à la fin le processus de pesée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A14:AQ14").Select
    Selection.AutoFilter

le chef d'équipe utilise la sheet de la semaine en cours en l'occurence IMS_CW35_2024 pour filtrer les gens, les jours et ainsi vérifier que tous le monde à peser.
Mais si il laisse le filtre cela plante le processus de pesée, à moins que par chance le nom de la personne qui effectue sa pesée est restée visible malgré les filtres.

Par contre, je pense que c'est une bonne solution de le retirer dès le début du processus, depuis la macro d'appel Sub CommandButton21_Click()

[rMist2024]

je ne suis pas sûr, je crois que cela va pas fonctionner car je souhaite retirer et remettre le filtre sur la sheet qui change de nom toutes les semaines exemple IMS_CW35_2024 et non la sheet Template_IMS

Alors on peut se référer à son Codename et pas au nom qui change régulièrement, dans le volet de l'explorateur du projet dans le éditeur de code vous pouvez constater que cette feuille est affichée avec le titre Feuil16(IMS_CW35_2024) donc c'est Feuil16 qu'il faut utiliser ( changer ce Codename pour un autre plus intuitif)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Function RetablirLeFiltre()
    Application.ScreenUpdating = False
    Dim PageFiltred
    For Each PageFiltred In Worksheets
       If PageFiltred.CodeName = "Feuil16" Then
         With PageFiltred
            .Range("A14:AQ14").AutoFilter
            .Range("A14:AQ14").AutoFilter Field:=1, Criteria1:="*"
          End With
          Exit For ' la page a été trouvée on sort de la boucle
       End If
    Next
End Function

Appeler cette fonction après de déverrouillage de code dans CommandButton21_Click

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub CommandButton21_Click() 'Bouton badger Caisse
 
unprot
 
RetablirLeFiltre
 
masq_auto 'Masquage automatique des onglets "LOG" / "Bdd_badge" / "Bdd_Safran"
 
....

[nirvana4483]

Bonjour, merci pour l'aide

Je ne savais pas qu'on pouvait avoir un codename d'une sheet au nom évolutif! Par contre je ne sais pas où trouver cet info de Feuil16

j'ai tenté d'adapter le code mais cela ne fonctionne pas, cela plante cela bloque à Feuil16

[rMist2024]

le dernier code est indépendant fonctionne sans les fonctions proposées avant il fait exactement la même tâche, je ai adapté directement à l'adresse indiqué dans ton dernier message "A14:AQ14" .

Mais si tu veux comparer les deux propositions donc utiliser une boucle pour trouver un sheet par son codename

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Function FindCodeName(ByVal aCodename As String)
    Dim v
    For Each v In Worksheets
       If v.CodeName = aCodename Then
          Set FindCodeName = v
          Exit For
       End If
    Next
End Function

pour utiliser FindCodeName("Feuil16")

[nirvana4483]

j'ai un peu honte, Je t'avoue que là je suis un peu perdu
hélas je ne suis pas un expert mais un bidouilleur

Pourrais tu me remettre l'intégralité de ton code pour arriver à nos fins

[rMist2024]

Pour faire simple il y a deux solutions donc soit l'une ou l'autre:

1) Les modifications à faire pour la première manip
Ajouter ces fonctions:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function FindCodeName(ByVal aCodename As String)
    Dim v
    For Each v In Worksheets
       If v.CodeName = aCodename Then
          Set FindCodeName = v
          Exit For
       End If
    Next
End Function
 
Function Retirer_Le_filtre()
 With FindCodeName("Feuil16")
   Dim lastcolonne As Long
   lastcolonne = .Range("IV14").End(xlToLeft).Column
   .Range("A14").Resize(1, lastcolonne).AutoFilter
 End With
End Function
 
Function Placer_Le_filtre()
 Dim RgAddr As String
 With FindCodeName("Feuil16")
   RgAddr = Split(.UsedRange.Address(False, False), ":")(1)
  .Range("A14:" & RgAddr).AutoFilter Field:=1, Criteria1:="*"
 End With
End Function

placer Retirer_Le_filtre et Placer_Le_filtre dans CommandButton21_Click

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub CommandButton21_Click() 'Bouton badger Caisse
 
unprot
 
Retirer_Le_filtre
 
masq_auto 'Masquage automatique des onglets "LOG" / "Bdd_badge" / "Bdd_Safran"
 
recherche_port
 
def_date 'Permet de connaitre la date en fonction de l'heure, Si avant 2h du matin date du jour -1, si après 2h matin date du jour
 
creat_IMS   'Creation de l'onglet IMS de la semaine en cours
 
badger_caisse 'Badgeage de la caisse + tare + recherche du numéro de caisse dans la bdd TOOLMOOV
 
MsgBox "Veuillez déposer la caisse sur le plateau de la balance" & vbCr & vbCr & "Puis appuyer sur la touche ENTER", vbOKOnly, "Action à effectuer"
 
pesee
 
comparaison
 
Placer_Le_filtre
 
prot
 
End Sub

2) Les modifications pour la deuxième manip

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Function RetablirLeFiltre()
    Application.ScreenUpdating = False
    Dim PageFiltred
    For Each PageFiltred In Worksheets
       If PageFiltred.CodeName = "Feuil16" Then
         With PageFiltred
            .Range("A14:AQ14").AutoFilter
            .Range("A14:AQ14").AutoFilter Field:=1, Criteria1:="*"
          End With
          Exit For ' la page a été trouvée on sort de la boucle
       End If
    Next
End Function

appeler cette fonction après unprot dans CommandButton21_Click

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub CommandButton21_Click() 'Bouton badger Caisse
 
unprot
 
RetablirLeFiltre
 
masq_auto 'Masquage automatique des onglets "LOG" / "Bdd_badge" / "Bdd_Safran"
 
....

[nirvana4483]

Excel n'aime pas la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lastcolonne = .Range("IV14").End(xlToLeft).Column

je me dis qu'au final il serait plus simple de juste resélectionner et recocher les sélections du filtre plutôt de le supprimer et le refaire

un peu comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub filtre
Dim ws As Worksheet
    Set ws = Feuil15
    'Sheets("IMS_CW41_2024").Select
    ActiveSheet.Range("$A$14:$AQ$156").AutoFilter Field:=1
End Sub

mais il faut savoir ou le placer dans tous le code et là j'ai un peu de mal

j'ai mis la macro dans la feuil15



edit: j'ai modifié avec call Feuil15.filtre dans feuil1 et rien le filtre se remet pas.. du coup erreur de recherche de nom derrière la macro pesée plante si c'est resté filtré

cela bloque a kR= rech_nom.row dans la macro rempl IMS, car le filtre n'a pas été resélectionner pourtant quand j'exécute la macro filtre seule cela fonctionne

[rMist2024]

Essaie de donner un nom à cette plage de filtre
Sélectionnez la plage ""$A$14:$AQ$156"
Aller dan l'onglet : Formules => Définir un nom et enter un nom de votre choix disons zonefiltre

Pour utiliser ce nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("zonefiltre").AutoFilter

[nirvana4483]

Merci pour ton aide

J'ai finalement réussi de cette manière dans le Module1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Sub filtre()
    ' Vérification de l'existence de la feuille via le CodeName (Feuil15)
    On Error Resume Next
    If Not Feuil15 Is Nothing Then
        ' Si la feuille existe, appliquer le filtre
        Feuil15.Range("$A$14:$AQ$156").AutoFilter Field:=1
    End If
    On Error GoTo 0
End Sub

et en appelant ce code depuis le bouton en début de processus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub CommandButton21_Click() 'Bouton badger Caisse

unprot
10/10/24 désactivation du filtre onglet IMS
Call Module1.filtre

masq_auto 'Masquage automatique des onglets "LOG" / "Bdd_badge" / "Bdd_Safran"

recherche_port

def_date 'Permet de connaitre la date en fonction de l'heure, Si avant 2h du matin date du jour -1, si après 2h matin date du jour
    
creat_IMS   'Creation de l'onglet IMS de la semaine en cours

badger_caisse 'Badgeage de la caisse + tare + recherche du numéro de caisse dans la bdd TOOLMOOV

MsgBox "Veuillez déposer la caisse sur le plateau de la balance" & vbCr & vbCr & "Puis appuyer sur la touche ENTER", vbOKOnly, "Action à effectuer"

pesee

comparaison
    
prot
    
End Sub

Pour ma culture, je me demande pourquoi j'ai dû mettre Call Module1.filtre et que filtre seul ne fonctionne pas.
Alors que les autres appels macro semblent fonctionner comme creat_IMS par exemple.. ou masq_auto etc