1 pièce(s) jointe(s)
Incrémentation de temps sous condition
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... :aie:
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:
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:
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
