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