Re : Calcul de nombre de jours dans un USF
Re Bonjour Catrice ci-dessous le code de mon application.
Tous les Gifs ne s'affichent pas.
Private Sub ComboBox1_Change()
Dim Cell As Range
Dim cherch As String, derlign As Long
derlign = Sheets("DATA").Range("A65536").End(xlUp).Row
cherch = ComboBox1
Set Cell = Sheets("DATA").Range("A2:A" & derlign).Find(cherch, LookAt:=xlWhole)
If Not Cell Is Nothing Then
TextBox2.Value = Cell.Offset(0, 1)
TextBox3.Value = Cell.Offset(0, 2)
TextBox4.Value = Cell.Offset(0, 3)
TextBox01.Value = Cell.Offset(0, 4)
TextBox02.Value = Cell.Offset(0, 5)
TextBox03.Value = Cell.Offset(0, 6)
TextBox04.Value = Cell.Offset(0, 7)
TextBox05.Value = Cell.Offset(0, 8)
TextBox06.Value = Cell.Offset(0, 9)
TextBox07.Value = Cell.Offset(0, 10)
TextBox08.Value = Cell.Offset(0, 11)
TextBox09.Value = Cell.Offset(0, 12)
TextBox10.Value = Cell.Offset(0, 13)
TextBox15.Value = Cell.Offset(0, 14)
WebBrowser01.Visible = False
WebBrowser02.Visible = False
WebBrowser03.Visible = False
WebBrowser04.Visible = False
WebBrowser05.Visible = False
WebBrowser06.Visible = False
WebBrowser07.Visible = False
WebBrowser08.Visible = False
WebBrowser09.Visible = False
WebBrowser10.Visible = False
'Focus sur le numéro de matricule
TextBox3.SetFocus
'Si employé contrôleur ("OUI") alors...
If TextBox2.Value = "OUI" Then
TextBox2.ForeColor = &H4000&
TextBox2.BackColor = &HFFFF&
'Si employé contrôleur ("NON") alors...
Else
TextBox2.ForeColor = &H80&
TextBox2.BackColor = &HFFFFFF
End If
'Couleurs Observations : Police blanche sur Fond rouge
If TextBox15.Value <> "" Then
TextBox15.BackColor = &HFF&
Else
TextBox15.BackColor = &HFFFFFF
End If
'B2
If TextBox01 <> "" Then
TxtBx01 = Round(CDate(TextBox01) - Now)
Couleur TxtBx01
Feux TxtBx01
Else
TxtBx01 = ""
WebBrowser01.Visible = False
End If
If TextBox02 <> "" Then
TxtBx02 = Round(CDate(TextBox02) - Now)
Couleur TxtBx02
Feux TxtBx02
Else
TxtBx02 = ""
WebBrowser02.Visible = False
End If
If TextBox03 <> "" Then
TxtBx03 = Round(CDate(TextBox03) - Now)
Couleur TxtBx03
Feux TxtBx03
Else
TxtBx03 = ""
WebBrowser03.Visible = False
End If
If TextBox04 <> "" Then
TxtBx04 = Round(CDate(TextBox04) - Now)
Couleur TxtBx04
Feux TxtBx04
Else
TxtBx04 = ""
WebBrowser04.Visible = False
End If
If TextBox05 <> "" Then
TxtBx05 = Round(CDate(TextBox05) - Now)
Couleur TxtBx05
Feux TxtBx05
Else
TxtBx05 = ""
WebBrowser05.Visible = False
End If
If TextBox06 <> "" Then
TxtBx06 = Round(CDate(TextBox06) - Now)
Couleur TxtBx06
Feux TxtBx06
Else
TxtBx06 = ""
WebBrowser06.Visible = False
End If
If TextBox07 <> "" Then
TxtBx07 = Round(CDate(TextBox07) - Now)
Couleur TxtBx07
Feux TxtBx07
Else
TxtBx07 = ""
WebBrowser07.Visible = False
End If
If TextBox08 <> "" Then
TxtBx08 = Round(CDate(TextBox08) - Now)
Couleur TxtBx08
Feux TxtBx08
Else
TxtBx08 = ""
WebBrowser08.Visible = False
End If
If TextBox09 <> "" Then
TxtBx09 = Round(CDate(TextBox09) - Now)
Couleur TxtBx09
Feux TxtBx09
Else
TxtBx09 = ""
WebBrowser09.Visible = False
End If
If TextBox10 <> "" Then
TxtBx10 = Round(CDate(TextBox10) - Now)
Couleur TxtBx10
Feux TxtBx10
Else
TxtBx10 = ""
WebBrowser10.Visible = False
End If
End If
On Error Resume Next
On Error GoTo 0
End Sub
'Couleurs des jours en fonction de la durée
Sub Couleur(Arg1)
Select Case Arg1
Case Is < 0: Arg1.ForeColor = &HFF&
Case 0 To 30: Arg1.ForeColor = &HFF0000
Case Is > 30: Arg1.ForeColor = &HFF00&
End Select
End Sub
Sub Feux(Arg1)
With Controls("WebBrowser" & Right(Arg1.Name, 2))
.Navigate "about:<html><body scroll='no' BottomMargin=0 LeftMargin=0 TopMargin=0 RigthMargin=0>" & _
"<img src='C:\temp\" & IIf(Arg1 >= 45, "feux020.gif", "feux019.gif") & "'width='33' height='33'></img></body></html>"
.Visible = True
End With
End Sub
Merci pour ton aide.
Cordialement.
