XL 2010 Remplacer DTPicker et mettre en format heure "hh:mm"

[Bekox]

Bonjour, mon problème est que, au boulot je n'ai pas la fonction DTPicker... J'aimerai savoir comment le remplacer ?
Et aussi je n'arrive pas à mettre le format heure "hh:mm" sur les colonnes B,C,D,F.
Mon tableau a des en-têtes ligne 1 de A à O.

Dans mon UserForm (FrmRechercheSuivi) :

Option Explicit

Private Sub CheckBox1Suivi_Click()
FrmRechercheSuivi.ListView1Suivi.ListItems.Clear
If CheckBox1Suivi.Value = True Then
CheckBox3Suivi.Value = False
End If

If CheckBox1Suivi.Value = True Then
DTPicker2.Enabled = False
Label4Suivi.Visible = True
Label2Suivi.Visible = False
Label1Suivi.Visible = False
Else
DTPicker2.Enabled = True
Label4Suivi.Visible = False
Label2Suivi.Visible = True
Label1Suivi.Visible = True
End If
AlimenteListviewDateSuivi
End Sub

Private Sub CheckBox3Suivi_Click()
If CheckBox3Suivi.Value = True Then
CheckBox1Suivi.Value = False
End If
End Sub

Private Sub CommandButton1Suivi_Click()
AlimenteListviewSuivi
lblNbInterRechercheSuivi.Caption = ListView1Suivi.ListItems.Count
End Sub

Private Sub DTPicker1_Change()
If DTPicker1.Value > VBA.Date Then
MsgBox "Vous ne pouvez pas sélectionner une date ultérieure à celle du jour!"
DTPicker1.Value = VBA.Date
End If
End Sub

Private Sub DTPicker1_CloseUp()
AlimenteListviewDateSuivi
End Sub

Private Sub DTPicker2_Change()
If DTPicker2.Value > VBA.Date Then
MsgBox "Vous ne pouvez pas sélectionner une date ultérieure à celle du jour!"
DTPicker2.Value = VBA.Date
End If
End Sub

Private Sub DTPicker2_CloseUp()
AlimenteListviewDateSuivi
End Sub

Private Sub UserForm_Initialize()
Dim Mondico As Object
Dim ws As Worksheet
Dim i, j As Long

'Initialisation des variables
Set ws = Sheets("Liste")
Set Mondico = CreateObject("Scripting.dictionary")

For j = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
Mondico(ws.Range("A" & j).Value) = ""
Next j

'Ajout des intervenants dans la combobox1
If Mondico.Count > 0 Then
Me.ComboBox1Suivi.List = Application.Transpose(Mondico.Keys)
End If

Set ws = Sheets("Liste")
Set Mondico = CreateObject("Scripting.dictionary")

For j = 2 To ws.Range("C" & Rows.Count).End(xlUp).Row
Mondico(ws.Range("C" & j).Value) = ""
Next j

'Ajout des activités dans la combobox2
If Mondico.Count > 0 Then
Me.ComboBox2Suivi.List = Application.Transpose(Mondico.Keys)
End If

Label4Suivi.Visible = False
''''''''''''''''''''''''''''''''''''''''''''

Sheets("Suivi d'intervention").Columns("A:N").AutoFit
'Configuration de la listview
With FrmRechercheSuivi.ListView1Suivi
.ListItems.Clear
With .ColumnHeaders
'Titres des colonnes
.Clear
'Ajout des colonnes
For i = 1 To 14
.Add , , Sheets("Suivi d'intervention").Cells(1, i).Text, Int(Sheets("Suivi d'intervention").Columns(i).ColumnWidth * 7), lvwColumnLeft
Next i
End With
' .Font.Size = 8
' .Font.Bold = False
' .BackColor = &HE8DEB7
.View = lvwReport 'affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes comlètes
.LabelEdit = lvwManual
.HotTracking = False
End With
''''''''''''''''''''''''''''''''''''''
End Sub
______________________________________________________________________________________________________________________________________________________________
Dans un module (RechercheSuivi) :

Option Explicit

Sub AlimenteListviewSuivi()
Dim i As Integer, j
Dim MonTab As Variant

MonTab = Sheets("Suivi d'intervention").Range("A2:N" & Sheets("Suivi d'intervention").Range("A" & Rows.Count).End(xlUp).Row)

'Remplissage de la listview
With FrmRechercheSuivi
.ListView1Suivi.ListItems.Clear
For i = 1 To UBound(MonTab, 1)
If MonTab(i, 1) <> "" _
And MonTab(i, 8) Like "*" & .TextBox3Suivi & "*" _
And MonTab(i, 9) Like "*" & .TextBox4Suivi & "*" _
And MonTab(i, 7) Like "*" & .ComboBox1Suivi & "*" _
And MonTab(i, 10) Like "*" & .ComboBox2Suivi & "*" Then

.ListView1Suivi.ListItems.Add , , MonTab(i, 1)
For j = 2 To 14
.ListView1Suivi.ListItems(.ListView1Suivi.ListItems.Count).ListSubItems.Add , , MonTab(i, j)
Next j
End If
Next i
End With
End Sub
Sub AlimenteListviewDateSuivi()
Dim i As Integer, j
Dim MonTab As Variant

MonTab = Sheets("Suivi d'intervention").Range("A2:N" & Sheets("Suivi d'intervention").Range("A" & Rows.Count).End(xlUp).Row)

'Remplissage de la listview
With FrmRechercheSuivi
.ListView1Suivi.ListItems.Clear
For i = 1 To UBound(MonTab, 1)
If .DTPicker2.Enabled = True Then
If MonTab(i, 1) <> "" And CDate(MonTab(i, 1)) >= .DTPicker1 And CDate(MonTab(i, 1)) <= .DTPicker2 Then
.ListView1Suivi.ListItems.Add , , MonTab(i, 1)
For j = 2 To 14
.ListView1Suivi.ListItems(.ListView1Suivi.ListItems.Count).ListSubItems.Add , , MonTab(i, j)
Next j
End If
Else
If MonTab(i, 1) <> "" And CDate(MonTab(i, 1)) = .DTPicker1 Then
.ListView1Suivi.ListItems.Add , , MonTab(i, 1)
For j = 2 To 15
.ListView1Suivi.ListItems(.ListView1Suivi.ListItems.Count).ListSubItems.Add , , MonTab(i, j)
Next j
End If
End If
Next i
End With
End Sub

 

[ChTi160]

Bonjour Bekox
Bonjour le Fil ,le Forum
Arffff ne peux tu mettre un fichier (Quelques Lignes sans données confidentielles) pour aider à la résolution de ton problème
jean marie

 

[Dranreb]

Bonjour.