Boucles If imbriquées avec condition de Date
Bonjour tout le monde,
Tout d'abord merci à ceux qui m'ont aidé précédemment, mon fichier est sur le point d'être terminé. Cependant deux derniers points restent à éclaircir, on parlera d'un seul des deux ici. C'est une erreur bête à mon avis, je dois faire un truc de travers. J'ai une listbox qui récupère les valeurs de mes plusieurs colonnes, ces valeurs sont réparties dans plusieurs labels immodifiables. De plus j'ai trois textbox qui permettent de modifier, ajouter (dans ma BDD) des valeurs de certaines cellule de la ligne sélectionnée dans la listbox. Dans deux de ces textbox sont renseignées des dates (ajout matériel et enlèvement matériel). Dans le code ci-dessous je n'arrive pas à faire fonctionner la boucle "If" (coloriée en rouge) : rendre impossible la modification et accompagner d'une msg box lorsque la date d'ajout matériel renseignée en Textbox11 > Textbox13 ( date d'enlèvement matériel).
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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
| Private Sub B_valid_Click()
Dim TextBox11 As Date
Dim TextBox13 As Date
Enreg = Me.Enreg
If Date < TextBox11 Then ' si la date du jour est inférieure à la date d'ajout matériel (matériel n'est pas en stock)
MsgBox "Le matériel n'est pas en stock ! Il le sera : " & Me.TextBox11, vbOKOnly + vbInformation, "Matériel prochainement en stock"
If TextBox11 > TextBox13 Then ' si la date d'ajout matériel est supérieure à la date d'enlèvement matériel (matériel n'est pas en stock, il ne peut pas être enlevé)
MsgBox "Le matériel sera en stock le : " & Me.TextBox11 & ",il ne peut être enlevé avant cette date", vbExclamation
If MsgBox("Confirmez-vous la demande de réservation de ce matériel ?", vbYesNoCancel, "Demande de confirmation de réservation") = vbYes Then
For c = 1 To NbCol
If Not Range(NomTableau).Item(Enreg, c).HasFormula Then
tmp = Me("textbox" & c)
If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
tmp = Replace(tmp, ".", ",")
Range(NomTableau).Item(Enreg, c) = CDbl(tmp)
Else
If IsDate(tmp) Then
Range(NomTableau).Item(Enreg, c) = CDate(tmp)
Else
Range(NomTableau).Item(Enreg, c) = tmp
End If
End If
Else
Range(NomTableau).Item(Enreg - 1, c).Copy
Range(NomTableau).Item(Enreg, c).PasteSpecial Paste:=xlPasteFormats
End If
Next c
If MsgBox("Souhaitez-vous générer la fiche de réservation matériel ?", vbYesNo, "Fiche identification matériel") = vbYes Then
With Sheets("Feuil2")
.Range("A1").Value = "N°" & TextBox1
.Range("B1").Value = "RESERVATION" & Chr(13) & Chr(10) & "Matériel: " & TextBox2 & Chr(13) & Chr(10) & "Marque: " & TextBox7
.Range("B2").Value = "Modèle: " & TextBox3 & Chr(13) & Chr(10) & "Puissance: " & TextBox4 & Chr(13) & Chr(10) & "Avec disjoncteur: " & TextBox5 & Chr(13) & Chr(10) & "Tension: " & TextBox6
.Range("B3").Value = TextBox8
.Range("B4").Value = "Ajouté par: " & TextBox9 & Chr(13) & Chr(10) & "Réservé par: " & TextBox12
.Range("B5").Value = "Entré le: " & Me.TextBox11 & Chr(13) & Chr(10) & "Enlevé le: " & TextBox13
.Range("B6").Value = TextBox10
End With
Unload Me
Application.ScreenUpdating = False
Sheets("Feuil2").PrintPreview
Application.ScreenUpdating = True
End If ' confirmation génération PDF
Exit Sub
End If ' exclamation impossible ajout > enlèvement
End If ' Confirmation réservation matériel
End If ' matériel n'est pas encore en stock
UserForm_Initialize
'raz
End Sub |
Si certains souhaitent, je ne sais pas si c'est possible, mais je peux leurs envoyer le fichier (en partie confidentiel) en message privé.
Je vous remercie d'avance pour le temps que vous prendrez pour me répondre.
Maxgui.
