Discussion :

[nirvana4483]

Bonjour à tous,

vous m'avez déjà aider sur ce lien, merci à @Franc et @Valtrase

https://www.developpez.net/forums/d2...ique-d-onglet/

Aujourd'hui je reviens vers vous pour une demande normalement la dernière pour ce fichier

c'est donc un fichier excel qui fonctionne avec une balance pour peser des caisses à outils matin et soir, en horaire 3x8. Afin d'éviter de perdre des outils

Le fichier enregistre les pesées et l'inscrit dans l'onglet IMS_CW15_2024, chaque nouvelle pesée écrase l'ancienne

J'aimerais tracer les 2 pesées quotidiennes cela soulève quelques problèmes :

1ère question : que se passe t'il si on pèse la caisse 3 ou 4 fois? (pesée NOK --> on recherche et retrouve l'outil manquant --> pesée OK)
2eme question : comment gérer la vacation grande nuit où la première pesée et la deuxième ne seront pas le même jour?

Si je veux absolument avoir la trace des deux pesées, le plus simple sera de rajouter une colonne dans l'onglet template IMS, d'écrire dans la première case et si la première case est remplie, écrire dans la deuxième.
Cela ne devrait engendrer qu'une modification de la boucle de remplissage de l'IMS

Souci cela dépasse un peu mes compétences

l'idée serait d'ajouter en bleu les 3 colonnes et inscrire les pesée a tour de rôle

si case B15 et E15 vides => remplir B15
si case B15 remplie et E15 vide => remplir E15
si case B15 remplie et E15 remplie => écraser B15
et ainsi de suite

ceci pour chaque jour de la semaine et chaque personne/ligne du fichier, la liste pouvant s'agrandir ou réduire, je n'ai pas modifié complètement le template j'ai juste fait le lundi

balance connecté PassWord -admin.xlsm PassWord: Admin

ceci est dans un but d'avoir une traçabilité de la pesée sur un document "officiel" car le fichier des log n'est pas lisible par le commun des mortels et ne peut servir de traçabilité

et aussi dans le but de supprimer une feuille papier que les opérateurs doivent signer 2 fois par jour en plus de leurs pesées pour attester que cela a été fait


voilà j'ai sûrement oublié des détails pour la compréhension, n'hésitez pas à me poser question

la modif je pense doit se passer dans la macro Sub creat_IMS module 1

Merci

[EricDgn]

Bonjour,

Une suggestion:

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
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)
        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) = "" Then
                kC = kC + 3                 '--- remplir 3 colonnes + loin
            End If
        End If
        If arg <> "" Then
            If .Cells(kL, kC) <> "MAJ" Then
                .Cells(kL, kC) = arg
            End If
            If arg = "MAJ" Then
                .Cells(kL, kC + 1) = ecart & " Kg " & vbLf & commentaire
            Else
                .Cells(kL, 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
    End With
 
    ThisWorkbook.Save
    Application.ScreenUpdating = True
End Sub

Pas possible pour moi de vérifier, le code se bloquant en l'absence de balance (et MSComm32.ocx manquant).
Cordialement

[EricDgn]

Plutôt ceci à la place des lignes n°12 à 16

Code :

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

1
2
3
4
5
6
         If .Cells(kR, kC) <> "" Then
            If .Cells(kR, kC + 3) <> "" Then           '--- colonne+3 déjà remplie
                .Cells(kR, kC) = .Cells(kR, kC + 3)     '--- recopie colonne+3 sur colonne
            End If
            kC = kC + 3                                 '--- remplir colonne+3
        End If

[nirvana4483]

Moi aussi le MSComm32.ocx manquant me bloque sur mon PC perso, cela facilite pas les tests. je ne sais pas comment le désactiver facilement

Merci pour ton code, je reviendrais certainement vers toi. Il faut que je me dégage du temps pour tester ca

[nirvana4483]

J'ai finalisé le template comme je l'imagine et j'ai intégré le code

j'ai été le testé avec la balance mais il se passe pas grand chose

je pense il faudrait isoler cette partie de code pour en vérifier son fonctionnement, mais c'est pas très évident pour moi de réussir à le faire

balance connecté PassWord -admin.xlsm

[Invité]

Dans le code il y a un variable non initialisé kL

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
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
            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
    End With
 
    ThisWorkbook.Save
    Application.ScreenUpdating = True
End Sub

la fonction unprot n'est pas implémentée correctement dans les appels imbriqués à la sortie elle active toujours ScreenUpdate

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
Sub unprot()
Dim oldScrenUpdate As Boolean
oldScrenUpdate = Application.ScreenUpdating
If oldScrenUpdate Then: Application.ScreenUpdating = False
 
Dim i As Integer
 
For i = 1 To Sheets.Count
   Sheets(i).Unprotect ("admin")
Next i
 
ThisWorkbook.Unprotect ("admin")
 
If oldScrenUpdate Then: Application.ScreenUpdating = True
 
End Sub

[nirvana4483]

elle a l'air initalisée pourtant non?

[Invité]

C'est le variable Kl que j'ai retiré

[nirvana4483]

je n'avais pas compris que tu avais modifié le code, il faut que je retest

[nirvana4483]

concernant la macro unprot, normalement elle n'a pas été touchée et ne cause pas de souci particulier

j'ai récupéré le fichier codé comme ceci

[Invité]

Le problème survient lorsque unprot est appelée à partir d'une autre fonction qui a déjà désactivé ScreenUpdate donc après l'appel ScreenUpdate est à true pour le reste du code appelant

ex:

Code :

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

1
2
3
4
5
6
7
8
Sub Workbook_Open() 'Actions effectuées à l'ouverture du fichier
    Application.ScreenUpdating = False
    Feuil1.Activate
    unprot ' ScreenUpdating passe à true
    ...
    ...
    Application.ScreenUpdating = True
End Sub

[nirvana4483]

Concernant le dysfonctionnement de la macro Unprot, j'essayerai de me pencher dessus plus tard. Merci beaucoup pour l'avoir relevé

Sinon j'ai été testé le code de la macro rempl_IMS, cela fonctionne. merci!

en gros cela fait

pesée 1 rien
pesée 1 pesée 2
pesée 3 rien
pesée 3 pesée 4
pesée 5 rien
etc


=>Mais j'aimerais récupérer la date et l'heure de la pesée et l'ajouter dans une case

Peut-être dans les cases colonne B/H/N/T.. ou l'on marque OK/ MAJ ou NOK, il serait bien d'avoir la date et l'heure dessous dans la même case

comme ceci:


car si l'opérateur pour raison lambda fait 4/5 pesées suite à un bug, la logique sera perdue. ils doivent pesée en début et en fin de vacation soit 2 pesées

admettons je vois
pesée pesée
17h30 18h30

je saurais directement qu'il faut aller voir les logs car cette ligne sera non fiable

mais cela dépense mes compétences

[Invité]

=>Mais j'aimerais récupérer la date et l'heure de la pesée et l'ajouter dans une case

Peut-être dans les cases colonne B/H/N/T.. ou l'on marque OK/ MAJ ou NOK, il serait bien d'avoir la date et l'heure dessous dans la même case

Je pense ajouter l'horaire de la vacation actuelle est plus pertinent cela permet de détecter le début et la fin de la vacation ctd la colonne dans laquelle la pesée sera placée donc il ne sera plus possible d’écrire la seconde pesée avant le passage à la vacation suivante .. cette information est enregistrée uniquement dans le première colonne ..maintenant il reste à définir comment bloquer toute mis a jour après certaine nombres de tentatives ou après le passage d'une certaine durée de temps.

la fonction SessionPlage indique l'actuelle session soit :
05:35-13:35
13:35-21:35
21:35-05:35

ajouter cette fonction configurée selon le code de GetNextSaveTime:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Public Function SessionPlage() As String
    Dim o, n
    o = Time
    'o = TimeSerial(8, 0, 0) ' pour test
    n = (Hour(o) * 60 + Minute(o) + 145) Mod 1440
    Select Case n \ 480
      Case 1: SessionPlage = "05:35-13:35"
      Case 2: SessionPlage = "13:35-21:35"
      Case 0: SessionPlage = "21:35-05:35"
    End Select
End Function

Code pour rempl_IMS:

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
39
40
41
42
43
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"
            Dim clStatus, vacation, SecondeVac
            vacation = SessionPlage
            SecondeVac = False
            clStatus = .Cells(kR, kC)
 
            If (clStatus <> "") And (InStr(clStatus, vacation) = 0) Then
                SecondeVac = True
                kC = kC + 3
            End If
 
            If InStr(.Cells(kR, kC), "MAJ") = 0 Then
               If SecondeVac Then
                  .Cells(kR, kC) = arg
               Else
                  .Cells(kR, kC) = arg & vbLf & vacation
               End If
            End If
 
            If arg = "MAJ" Then
               .Cells(kR, kC + 1) = ecart & " Kg " & vbLf & commentaire
            Else
               .Cells(kR, kC + 1) = ecart & " Kg"
            End If
          Autoremplissage kC, Worksheets("IMS_CW" & num_sem & "_" & annee)
             .Protect Password:="admin", DrawingObjects:=True, Contents:=True, Scenarios:=True
        End If
    End With
 
    ThisWorkbook.Save
    Application.ScreenUpdating = True
End Sub

[nirvana4483]

Alors désolé la vacation " ctd la colonne" , j'ai pas compris ctd


En fait l'obligation production est de peser sa caisse:
=>avant de s'en servir en début de vacation
=>et une fois la vacation terminée, caisse rangée
pour s'assurer de n'avoir pas perdu un outil

vacation 1: 5H/13H
vacation 2: 13H/21H
vacation 2: 21H/5H

le souci parfois l'opérateur peut se tromper, avoir oublier un outils avant de pesée, avoir ajouter un outil divers, on a aussi des problèmes avec les variations d'humidité parfois. De base l'opérateur peur faire autant de pesées qu'il a envi, mais à 90% il en fait 1 début et fin de vac

c'est pas évident.

mon but est d'avoir l'information des 2 pesées dans l'onglet IMS, afin que le chef d'équipe puisse vérifier facilement. Actuellement on a l'info que d'1 pesée et les suivantes écrasent l'info. Actuellement les opérateurs signent un doc papier. L'onglet IMS pourrait faire office de traçabilité et supprimer le papier.


En gros quand tout se passe bien sans problèmes, on aurait l'info des 2 pesées, dès qu'il y a un bug opérationnel cela complique.

=>Admettons pesée début de vac OK

=>Fin de vac l'opérateur oubli un outil, il sera en erreur

=>Du coup il refera une 3ième pesée et dans l'onglet IMS on aura plus que l'info de la 3ième pesée, la 1 et la 2 ainsi supprimées.

C'est pour cela qu'avoir l'heure dans la vacation est utile, si j'ai qu'une pesée à 20h50 dans la vacation 2, je saurais qu'il y a certainement eu d'autres pesées en début de vac avant (mais écrasée) qu'on ne voit plus dans l'onglet IMS, mais visible dans les LOG pour l'admin

[Invité]

Pour afficher les plages horaires correctement il suffit de changer le constant dans la fonction SessionPlage de 145 à 180 ( si jamais la fonction suscite l’intérêt)

Malheureusement les tests que j'ai effectué ne concernent que cette partie du code la fonction rempl_IMS elle facile à isoler dans un nouveau classeur, il n'est pas possible de faire fonctionner l'ensemble de votre fichier pour avoir une idée globale sur son fonctionnement

Pour enregistrer le temps de la prise dans la cellule ajouter Time à l'ancien code
Cette partie plus précisément

Code :

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

1
2
3
            If .Cells(kR, kC) <> "MAJ" Then
               .Cells(kR, kC) = arg & vbLf & Format(Time, "hh:mm")
            End If

[EricDgn]

Je mettrais plutôt

Code :

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

                  .Cells(kR, kC) = arg & vbLf & Format(Now, "dd/mm/yy hh\hnn")

[Invité]

La grille elle constitue une sorte de calendrier, l'affichage de l'heure et les minutes est largement suffisant
Format(Time, "hh:mm")

[nirvana4483]

j'ai testé cela semble fonctionné je préfère quand même la ligne ci-dessous

Code :

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

.Cells(kR, kC) = arg & vbLf & Format(Now, "dd/mm/yy hh\hnn")

Par contre j'ai un souci avec le code initial de la macro, celui-ci écrase ma mise en page que j'ai modifiée à la main afin de doubler les colonnes pour notre modif de l'information de double peséee:-(

j'avais modifié à la main ainsi



et on se retrouve comme ceci

[nirvana4483]

je crois savoir pourquoi je n'ai pas modifié le template qui sert de base

je dois adapter la macro, pour la mise en place des mises en forme conditionnelle, la création des dates car toutes les cellules ont changées etc

[nirvana4483]

Bonjour,

Grâce à vous, j'approche de mon but petit à petit, mais j'ai encore quelques désagréments

j'ai tenté d'adapter la macro au nouveau template

souci 1: avec cette macro

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
Sub Autoremplissage(colonne, feuille)
 
Dim cellule As Range
Dim zone As Range
 
der_lig feuille, "A13"
dern_ligne_IMS = dern_ligne
col = (colonne - 2) / 3
 
If col > 0 Then
    For i = 1 To col
        For j = 15 To dern_ligne_IMS
            If feuille.Cells(j, colonne - (i * 3)) = "" Then
                'feuille.Cells(j, colonne - (i * 3)) = "OK"
                feuille.Cells(j, colonne - (i * 3)) = "Pesée non faite"
                'feuille.Cells(j, colonne - (i * 3) + 1) = "AUTOVALIDATION"
                feuille.Cells(j, colonne - (i * 3) + 1) = "Pesée non faite"
            End If
        Next j
    Next i
End If
 
End Sub

j'aimerais que cela se rempli aussi dans mes nouvelles colonnes créées E/F, K/L etc de l'onglet IMS
Car actuellement les personnes n'ayant pas encore pesé en début de vac, se retrouve avec "pesée non faite" dans la première colonne, et lors de leur 1ière pesée de leur début de vac cela atterri donc dans la colonne normalement prévue pour la fin de vac





souci 2: dans la macro creat_IMS

le remplissage automatique semble ne pas fonctionner, je n'arrive pas à faire fonctionner la mise en forme conditionnelle



Vu qu'on a rajouté l'heure cela ne fonctionne plus, il faut que cela déclenche si la cellule contient OK, NOK, MAJ et non plus si elle est égale à OK, NOK, MAJ

ma modif de code me semble bonne pourtant , mais j'ai l'impression que le remplissage de l'onglet IMS de la semaine fonctionne mal.
La mise en forme conditionnelle avec les couleurs rouge orange vert ne fonctionnent pas
et j'ai un doute que cela fonctionne bien pour le remplissage des dates de chaque jour de la semaine

Dernier fichier modifié ici