Demande d'aide de modification d'un fichier excel + VBA gérant une balance

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

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:

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:

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

04/10/2024, 11h45
nirvana4483

merci je vais regarder et tester cela la semaine prochaine
07/10/2024, 08h29
nirvana4483

1 pièce(s) jointe(s)
Je n'ai pas encore eu le temps d'aller tester, car ceci n'est pas ma tâche principale :marteau:

je ne suis pas sûr, je crois que cela va pas fonctionner :bug: 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
Pièce jointe 660184

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

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:

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()

Citation:

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:

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:

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" ....

08/10/2024, 09h22
nirvana4483

1 pièce(s) jointe(s)

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 :bug: cela bloque à Feuil16

Pièce jointe 660254

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:

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")

08/10/2024, 14h46
nirvana4483

j'ai un peu honte, Je t'avoue que là je suis un peu perdu :marteau:
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

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:

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:

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:

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:

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"
 
....

09/10/2024, 14h11
nirvana4483

2 pièce(s) jointe(s)
Excel n'aime pas la ligne

Code:

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:

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 Pièce jointe 660310

Pièce jointe 660311

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
09/10/2024, 17h43
Invité

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:

Range("zonefiltre").AutoFilter

Merci pour ton aide :applo::bravo::ccool:

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

Code:

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:

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

Voir 40 message(s) de cette discussion en une page