Discussion :

[Blend]

Bonjour à tous,

Après un passage il y a quelques semaines, me voilà de nouveau confronté à un problème de macro que je n'arrive pas à résoudre...

En effet, mon dossier (en pièce jointe) a été en partie réalisé par vos soins. Mais après plusieurs modifications et tentatives de m'adapter en fonction des personnes qui complètent ce fichier, j'ai perdu un certain fil dans mes macros.

Mon problème est le suivant: Lorsque je ne met ni la durée ni la fréquence en feuille 'saisie-pilote', la fréquence se met automatiquement à 1 et la durée à 00:05 après le choix de la Machine/Cause. Cependant dans la feuille 'CalculsMacros' la durée ne s'incrémente pas de 5min (mais la fréquence oui).

J'ai 2 macros pour gérer l'incrémentation de temps et de fréquence. J'ai donc peur qu'elles ne soient pas forcément complémentaires...

Voici les deux lignes de codes pour ceux qui ne souhaitent pas ouvrir le fichier:
Rajout automatique de la fréquence et du temps

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
Private Sub Cause()
    Dim Rg As Range
 
    Set Rg = Me.Shapes(Application.Caller).TopLeftCell.Offset(, -2)
        t$ = Rg.Value:  If t = "" Then t = Rg.End(xlUp).Value
 
    With Feuil1
        With .Cells(.Rows.Count, 5).End(xlUp).Offset(1)
                        .Value = t
            .Offset(, 1).Value = Rg.Offset(, 1).Value
 
            If .Offset(, -1) = "" And .Offset(, -2) = "" Then
                .Offset(, -1).Value = 1
                .Offset(, -2).Value = TimeValue("0:05")
 
            End If
        End With
 .Activate
 
    End With
 
    Set Rg = Nothing
End Sub

Incrémentation du temps et fréquence dans le module 'saisie-pilote'

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
'la macro se déclenche à chaque fois qu'une valeur est entrée dans une cellule de la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
 
'Définir les variables
    If Target.Column <> 6 Then Exit Sub ' le target ne concerne que la colonne 6
    Dim Ligne As Integer
    Dim trouvé As Boolean
    trouvé = False
    'si toutes les colonnes de 3 à 6 sont renseignées
    If Target.Offset(0, 0) = "" And Target.Offset(0, -2) = "" And Target.Offset(0, -3) = "" Then
        MsgBox " Renseigner au minimum le début, la durée ou la fréquence"
 
        Exit Sub
    Else
        With Sheets("CalculsMacros")
          'on cherche sur la feuille "CalculsMacros" la première ligne de la machine correspondant à l'évènement
           Ligne = Application.Match(Cells(Target.Row, 5), .[A:A], 0) ' départ de la recherche
 
           Do While .Cells(Ligne, 1) = Target.Offset(0, -1) ' "Autre" est traité comme un cas courant dans la boucle
 
              If .Cells(Ligne, 3) = Target Then
                  If Target.Offset(0, -2) <> "" Then
                     .Cells(Ligne, 5) = .Cells(Ligne, 5) + TimeValue("0:05") * Cells(Target.Row, 4)
                     .Cells(Ligne, 8) = .Cells(Ligne, 8) + Cells(Target.Row, 4)
                  Else
                     .Cells(Ligne, 5) = .Cells(Ligne, 5) + Cells(Target.Row, 3)
                     .Cells(Ligne, 8) = .Cells(Ligne, 8) + 1
                  End If
                  trouvé = True
                  Exit Do
              End If
              Ligne = Ligne + 1
          Loop
 
          If trouvé = False Then
             MsgBox " Cas incompatible avec le choix dans une liste "
          End If
        End With
    End If
End Sub

En espérant avoir le plus clair possible.

Bien cordialement,

Blend