Excel dtpicker probleme

Bonjour,

Tu n'as pas plus d'informations à nous donner ? Quel message d'erreur as-tu ? Ou sont placés tes DTPicker ? etc ...

On est sur un forum d'aide informatique, pas de voyance ... ^^

;o)

lol ! alors j'ai 3 userform qui utilise le dtpicker !

les code pour le premier userform :Private Sub CommandButton1_Click()

With Ws_Client 'Worksheets("Fichier client")
.Activate
ActiveWindow.ScrollColumn = 1
' .Range("A1").Select
Derlign = .Range("A65536").End(xlUp).Row + 1

.Range("A" & Derlign).Value = Nom.Value
.Range("B" & Derlign).Value = Prenom.Value
.Range("C" & Derlign).Value = Adresse.Value
.Range("D" & Derlign).Value = Format(CP, "## ###")
.Range("E" & Derlign).Value = Ville.Value
.Range("F" & Derlign).Value = Tel.Value
.Range("G" & Derlign).Value = Portable.Value
.Range("H" & Derlign).Value = Mail.Value
'.Range("H" & Derlign).Select

Derlign = .Range("A65536").End(xlUp).Row + 1
.Range(.Cells(1, 1), .Cells(Derlign, 9)).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("A:H").AutoFit
Range("A2").Select
End With
With Sheets("Fichier client")
.Activate
Range("A1").Select
End With
Unload UsF_EntreeClient
UsF_Menu.Show
End Sub

Private Sub CommandButton2_Click()
Unload UsF_EntreeClient
UsF_Menu.Show
End Sub

Private Sub CP_AfterUpdate()
With Me.CP
.Value = Format(.Value, "00"" ""000")
End With
End Sub

Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub Nom_Change()
Me!Nom = UCase(Me!Nom)
End Sub

Private Sub Portable_AfterUpdate()
With Me.Portable
.Value = Format(.Value, "00"" ""00"" ""00"" ""00"" ""00")
End With
End Sub

Private Sub Prenom_Afterupdate()
With Me.Prenom
.Value = Application.WorksheetFunction.Proper(.Value)
End With
End Sub

Private Sub Tel_AfterUpdate()
With Me.Tel
.Value = Format(.Value, "00"" ""00"" ""00"" ""00"" ""00")
End With
End Sub

Private Sub UserForm_Initialize()
Set Ws_Client = Worksheets("Fichier client")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub Ville_AfterUpdate()
Me.Ville.Value = Application.WorksheetFunction.Proper(Me.Ville.Value)
End Sub

code pour le deuxieme userform

Option Explicit
Dim enregistrement As Boolean
Dim item1 As Integer
Dim lig As Long
Dim i As Integer
Dim total As Currency
Dim val1 As Currency

Private Sub ComboBox1_Change()

End Sub

Private Sub ComboBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call calcul2
End Sub

Private Sub ComboBox8_Change()

End Sub

'-------------------------------------------------------------
' Module : UserForm1/CommandButton1_Click
' Auteur : JP14
' Bouton :ecrire les données
'-------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim trouve As Boolean
Dim dl1 As Long ' dernière ligne
Dim Sh As Worksheet

If ComboBox1.ListIndex = -1 Then Exit Sub
If ComboBox8.ListIndex = -1 Then Exit Sub
If ComboBox9.ListIndex = -1 Then Exit Sub
Call calcul2
trouve = False
For Each Sh In Worksheets
If Sh.Name = ComboBox1.Value Then
trouve = True
End If
Next Sh
If trouve = False Then
With Sheets("Nom du client")
.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = ComboBox1.Value
Range("B1") = ComboBox1.Value
Range("b2") = Sheets("Fichier client").Range("b" & ComboBox1.ListIndex + 2).Value
End With
End If
With Sheets(ComboBox1.Value)
For i = 1 To ListView1.ListItems.Count

dl1 = .Range("b65536").End(xlUp).Row + 1
'''''''' .Range("b" & dl1).Value = DTPicker2.Value
.Range("c" & dl1).Value = ListView1.ListItems(i).Text
.Range("d" & dl1).Value = ListView1.ListItems(i).ListSubItems(1).Text
.Range("e" & dl1).Value = ListView1.ListItems(i).ListSubItems(2).Text
.Range("f" & dl1).Value = ComboBox6.Value
.Range("i" & dl1).Value = ComboBox9.Value

Next i
dl1 = .Range("b65536").End(xlUp).Row + 1
''''.Range("b" & dl1).Value = DTPicker2.Value

.Cells(dl1, 5).Value = TextBox5.Value
.Cells(dl1, 6).Value = ComboBox6.Value
.Cells(dl1, 7).Value = TextBox7.Value
.Cells(dl1, 8).Value = ComboBox8.List(ComboBox8.ListIndex, 1)
.Cells(dl1, 9).Value = ComboBox9.Value
End With
enregistrement = True
End Sub
'-------------------------------------------------------------
' Module : UserForm1/CommandButton2_Click
' Auteur : JP14
' Bouton :Quitter
'-------------------------------------------------------------
Private Sub CommandButton2_Click()
If enregistrement = False Then
Select Case MsgBox("Vous n'avez pas enregistrer vos données." _
& vbCrLf & "" _
& vbCrLf & "Voulez vous quitter ?" _
, vbYesNo Or vbInformation Or vbDefaultButton1, Application.Name)

Case vbYes
Unload Me
Case vbNo
Exit Sub
End Select
End If
Unload Me
End Sub
'-------------------------------------------------------------
' Module : UserForm1/CommandButton3_Click
' Auteur : JP14
' Bouton :valider
'-------------------------------------------------------------
Private Sub CommandButton3_Click()
If ListBox2.ListIndex = -1 Then Exit Sub
enregistrement = False
Call rlistview1(DESIGNATION:=ListBox2.Value, Quant:=0, PVTTC:=0)
ListBox2.ListIndex = -1
Call calcul2
End Sub
'-------------------------------------------------------------
' Module : UserForm1/CommandButton4_Click
' Auteur : JP14
' Bouton :supprimer
'-------------------------------------------------------------
Private Sub CommandButton4_Click()
Call veriflig(1, 0, item1)
If item1 = -1 Then Exit Sub
ListView1.ListItems.Remove item1
item1 = -1
Call calcul2
End Sub
'-------------------------------------------------------------
' Module : UserForm1/CommandButton5_Click
' Auteur : JP14
' Bouton :ajouter produits
'-------------------------------------------------------------
Private Sub CommandButton5_Click()

Call veriflig(2, lig, item1)

If item1 = -1 Then
Call MsgBox("Vous devez choisir un produit" _
& vbCrLf & "" _
& vbCrLf & "" _
, vbInformation, Application.Name)

Exit Sub
End If
If ListView2.ListItems(item1).ListSubItems(2).Text = 0 Then
Call MsgBox("Attention : le produit n'est pas en stock", vbInformation, Application.Name)
Exit Sub
End If

Call rlistview1(DESIGNATION:=ListView2.ListItems(item1).Text, _
Quant:=ListView2.ListItems(item1).ListSubItems(1).Text, _
PVTTC:=ListView2.ListItems(item1).ListSubItems(2).Text)
item1 = -1

Call calcul2
End Sub
'-------------------------------------------------------------
' Module : UserForm1/ListBox1_Click
' Auteur : JP14
' Utilisation :sélection d'une prestation
'-------------------------------------------------------------
Private Sub ListBox1_Click()
Dim feu1 As String
If ListBox1.TopIndex = -1 Then Exit Sub
ListBox2.RowSource = ""
ListBox2.Clear
On Error Resume Next
ListBox2.RowSource = ListBox1.List(ListBox1.ListIndex, (ListBox1.ColumnCount - 1))

End Sub

Private Sub ListView2_BeforeLabelEdit(Cancel As Integer)

End Sub

Private Sub UserForm_Initialize()

With ListBox1 ' ComboBox1
.Clear
.ColumnCount = 2
.ColumnWidths = "50;0"

.AddItem "Autres"
.List(.ListCount - 1, .ColumnCount - 1) = "autres"
.AddItem "Soins visage"
.List(.ListCount - 1, .ColumnCount - 1) = "Soins_visage"
.AddItem "Massages"
.List(.ListCount - 1, .ColumnCount - 1) = "Massages"
.AddItem "Soins du corps"
.List(.ListCount - 1, .ColumnCount - 1) = "Soins_corps"
.AddItem "Maquillage"
.List(.ListCount - 1, .ColumnCount - 1) = "Maquillage"
.AddItem "Epilations"
.List(.ListCount - 1, .ColumnCount - 1) = "Epilations"
.AddItem "Forfait épilation"
.List(.ListCount - 1, .ColumnCount - 1) = "Forfait_epilation"
End With
''''''''''''''''DTPicker2.Value = Format(Now, "dd/mm/yyyy")
' on indique le nom de la colonne suivie de la largeur
'Call entete(numéro de la listview , Array(titre de la première colonne , dimention de la colonne , titre de la deuxième colonne, dimention de la colonne, ....))
'"Date de visite "Prestation" 1 Prestation 2 Prestation 3 Produit acheté 1 Produit acheté 2 Produit acheté 3 Remises Montant facturé Mode de paiement Esthéticienne

Call entete(1, Array("DESIGNATION", 80, "Quant", 80, "PVTTC", 50))
Call entete(2, Array("DESIGNATION", 80, "ML", 50, "PVTTC", 50, "Stock", 50))
Call Affiche(2, "Produits", "b", Array("c", "e", "f"))

Call IniCombobox1(£nomfeuil:="Fichier client", £col:="a", £lig:=2, £num:=1, tri1:=True)

Call IniCombobox1(£nomfeuil:="Calcul", £col:="e", £lig:=4, £num:=9, tri1:=True)
Call IniCombobox1(£nomfeuil:="Calcul", £col:="b", £lig:=4, £num:=8, tri1:=True)
ComboBox6.AddItem Format(0.05, "0.00%")
ComboBox6.AddItem Format(0.1, "0.00%")
ComboBox6.AddItem Format(0.15, "0.00%")
ComboBox6.AddItem Format(0.2, "0.00%")
ComboBox6.AddItem Format(0.25, "0.00%")
ComboBox6.AddItem Format(0.3, "0.00%")
TextBox5.Value = 0
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
'*************************************************************
' sous programmes
'
'*************************************************************
'-------------------------------------------------------------
' Module : usfAffichage/Affiche
' Auteur : JP14
' Utilisation : remplir une listview
'-------------------------------------------------------------
Private Sub Affiche(£nu As Integer, £nomfeu As String, £premcol As String, £donne As Variant)
Dim £derlig As Long
Dim £i As Long
Dim £j As Integer

With Me.Controls("Listview" & £nu)
.ListItems.Clear
£derlig = Sheets(£nomfeu).Cells.SpecialCells(xlCellTypeLastCell).Row
For £i = 2 To £derlig

.ListItems.Add , "K" & £i, Sheets(£nomfeu).Range(£premcol & £i).Value
For £j = LBound(£donne) To UBound(£donne)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets(£nomfeu).Range(CStr(£donne(£j)) & £i).Value
Next £j
Next £i
.View = 3
.Gridlines = True
.FullRowSelect = True
.HideColumnHeaders = False
.LabelEdit = 1
.ListItems(1).Selected = False ' on désélectionne la première ligne
Set .SelectedItem = Nothing
End With
End Sub
'-------------------------------------------------------------
' Module : usfAffichage/entete
' Auteur : JP14
' Utilisation : créer une listeview
'-------------------------------------------------------------
Private Sub entete(£nu As Integer, £donne As Variant)
Dim £i As Integer

With Me.Controls("Listview" & £nu)

With .ColumnHeaders

.Clear 'Supprime les anciens entêtes
For £i = LBound(£donne) To UBound(£donne) Step 2
.Add , , CStr(£donne(£i)), CLng(£donne(£i + 1))
Next £i
End With
End With
End Sub
Private Sub rlistview1(DESIGNATION As String, Quant As Currency, PVTTC As Currency)
With Me.Controls("Listview" & 1)
.ListItems.Add , , DESIGNATION
.ListItems(.ListItems.Count).ListSubItems.Add , , Quant
.ListItems(.ListItems.Count).ListSubItems.Add , , PVTTC

.View = 3
.Gridlines = True
.FullRowSelect = True
.HideColumnHeaders = False
.LabelEdit = 1
.ListItems(1).Selected = False ' on désélectionne la première ligne
Set .SelectedItem = Nothing
End With
End Sub

'-------------------------------------------------------------
' Module : usfAffichage/veriflig
' Auteur : JP14
' Utilisation : on recherche si une ligne est sélectionnée
' ligne1 contient le numéro de la ligne dans la base de donnée
'£nu numéro de la listeview
'£i numéro de l'item sélectionné
'-------------------------------------------------------------
Private Sub veriflig(£nu As Integer, ligne1 As Long, £i As Integer)
ligne1 = 0
With Me.Controls("Listview" & £nu)
For £i = 1 To .ListItems.Count
If .ListItems(£i).Selected = True Then
'ligne1 = Mid(.ListItems(£i).Key, 2, 50)
Exit Sub
End If
Next £i
End With
£i = -1
End Sub
'-------------------------------------------------------------
' Module : UserForm41/IniCombobox1
' Auteur : JP14
' Utilisation :
' call IniCombobox1(£nomfeuil:= "feuil1", £col:="a", £lig:=2 (ligne départ), £num:=1, tri1:= true)
'-------------------------------------------------------------
Private Sub IniCombobox1(£nomfeuil As String, £col As String, £lig As Long, £num As Integer, tri1 As Boolean)
Dim plg As Variant, Col As New Collection, Item As Variant
Dim £i1 As Long
Dim £i As Long
Dim £tablo()
Dim £cellule As Range
With Sheets(£nomfeuil)
£i1 = .Range(£col & "65535").End(xlUp).Row
If £i1 < £lig Then Exit Sub
If £i1 = £lig Then
With Me.Controls("combobox" & £num)
.AddItem .Range(£col & £lig)
If £num = 8 Then .Columns(1, .ListCount - 1) = .Range(£col & £lig).Offset(0, 1)
End With
Exit Sub
End If
plg = .Range(£col & £lig & ":" & £col & £i1) 'On récupère les données
End With
' on rempli la collection les valeurs sont uniques
For £i = 1 To UBound(plg, 1)
On Error Resume Next
Col.Add plg(£i, 1), CStr(plg(£i, 1))
Next £i
On Error GoTo 0
'ReDim £tablo(0 To Col.Count + 1, 1 To 1)
ReDim £tablo(1 To Col.Count)
£i1 = 1
For Each Item In Col
£tablo(£i1) = Item
£i1 = £i1 + 1
Next Item
Me.Controls("combobox" & £num).Clear
If tri1 = True Then Call tri(£tablo(), 1, UBound(£tablo, 1))

Me.Controls("combobox" & £num).List = £tablo
End Sub

'-------------------------------------------------------------
' Module : tri
'Il s'agit d'une méthode de tri récursive dont l'efficacité est
'une fonction croissante du désordre dans le tableau à trier,
'c’est à dire que plus le tableau est désordonné,
'plus cette méthode de tri est efficace.
' Utilisation :trier les données dans le tableau dynamique ()
'-------------------------------------------------------------
Private Sub tri(£a(), £gauc, £droi) ' Quick sort
Dim £ref As Variant, £g As Long, £d As Long
Dim £temp As Variant
£ref = £a(Int((£gauc + £droi) \ 2))
£g = £gauc: £d = £droi
Do
Do While £a(£g) < £ref: £g = £g + 1: Loop
Do While £ref < £a(£d): £d = £d - 1: Loop
If £g <= £d Then
£temp = £a(£g): £a(£g) = £a(£d): £a(£d) = £temp
£g = £g + 1: £d = £d - 1
End If
Loop While £g <= £d
If £g < £droi Then Call tri(£a, £g, £droi)
If £gauc < £d Then Call tri(£a, £gauc, £d)
End Sub
Private Sub calcul(total As Currency)
total = 0
For i = 1 To ListView1.ListItems.Count
If IsNumeric(ListView1.ListItems(i).ListSubItems(2).Text) Then
total = total + CCur(ListView1.ListItems(i).ListSubItems(2).Text)
End If
Next i
End Sub
Private Sub calcul2()
Call calcul(total)
TextBox5.Value = total
If ComboBox6.ListIndex = -1 Then
TextBox7.Value = total
Else
val1 = 1 - Val(Replace(ComboBox6.Value, ",", ".")) / 100
TextBox7.Value = total * val1
End If
End Sub

et code du troisieme:

Dim i As Integer
Private Sub CommandButton1_Click()
Unload Me
End Sub

'-------------------------------------------------------------------------------------
' Module : UsF_Recapjournée/CommandButton2_Click
' DateTime : 13/02/2009 / 14:05
' Auteur : JP14
' Bouton :calcul
' Variable entrée/sortie :
' Appel procédure ou fonction :
' Utilisation :
'-------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
With Me.Controls("Listview1")
For i = 1 To .ListItems.Count
Select Case .ListItems(i).ListSubItems(4).Text
Case "cheque" '2
TextBox2.Value = CCur(TextBox2.Value) + CCur(.ListItems(i).ListSubItems(5).Text)

Case "cb" '3
TextBox3.Value = CCur(TextBox3.Value) + CCur(.ListItems(i).ListSubItems(5).Text)

Case "especes" '1
TextBox1.Value = CCur(TextBox1.Value) + CCur(.ListItems(i).ListSubItems(5).Text)

End Select
TextBox4.Value = CCur(TextBox4.Value) + CCur(.ListItems(i).ListSubItems(5).Text)
Next i
End With
End Sub

'-------------------------------------------------------------------------------------
' Module : UsF_Recapjournée/DTPicker1_Change
' DateTime : 13/02/2009 / 14:19
' Auteur : JP14
' Utilisation :changement date
'-------------------------------------------------------------------------------------
Private Sub DTPicker1_Change()
For i = 1 To 4
Me.Controls("TextBox" & i).Value = 0
Next i
Call Affiche(1, "Histo", "a", Array("b", "c", "d", "e", "f"))
End Sub

Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)

End Sub

'Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'If ColumnHeader.Index - 1 = 0 Then Exit Sub ' pas de tri sur les dates
'ListView1.Sorted = False
' ListView1.SortKey = ColumnHeader.Index - 1
'
' If ListView1.SortOrder = lvwAscending Then
' ListView1.SortOrder = lvwDescending
' Else
' ListView1.SortOrder = lvwAscending
' End If
'
' ListView1.Sorted = True
'End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()
'''DTPicker1.Date = Format(Now, "dd/mm/yyyy")
' on indique le nom de la colonne suivie de la largeur
'Call entete(numéro de la listview , Array(titre de la première colonne , dimention de la colonne , titre de la deuxième colonne, dimention de la colonne, ....))
Call entete(1, Array("date", 80, "NOM", 80, "PRENOM", 50, "PRESTATIONS", 100, "PAIEMENT par", 50, "MONTANT", 50))
'Call Affiche(numéro de la listview, nom de la feuille , première colonne , Array(deuxième colone , "d", "e", "f", "g", "h", "i"))
Call Affiche(1, "Histo", "a", Array("b", "c", "d", "e", "f"))

For i = 1 To 4
Me.Controls("TextBox" & i).Value = 0
Next i

End Sub
'-------------------------------------------------------------------------------------
' Module : usfAffichage/Affiche
' DateTime : 28/04/2008 / 18:52
' Auteur : JP14
' Utilisation : remplir une listview
'-------------------------------------------------------------------------------------
Private Sub Affiche(£nu As Integer, £nomfeu As String, £premcol As String, £donne As Variant)
Dim £derlig As Long
Dim £i As Long
Dim £j As Integer

With Me.Controls("Listview" & £nu)
.ListItems.Clear
£derlig = Sheets(£nomfeu).Cells.SpecialCells(xlCellTypeLastCell).Row 'Column
' Initialisation de la ligne dans le listview

' Boucle de la ligne 2 à la dernière
For £i = 2 To £derlig
' si on désire une sélection il faut ajouter les lignes if end if
If CStr(Format(Sheets(£nomfeu).Range("a" & £i), "dd/mm/yyyy")) = CStr(DTPicker1.Value) Then
.ListItems.Add , "K" & £i, Sheets(£nomfeu).Range(£premcol & £i).Value
For £j = LBound(£donne) To UBound(£donne)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets(£nomfeu).Range(CStr(£donne(£j)) & £i).Value
Next £j
End If
Next £i

.View = 3
.Gridlines = True
.FullRowSelect = True
.HideColumnHeaders = False
.LabelEdit = 1
'.ListItems(1).Selected = False ' on désélectionne la première ligne
Set .SelectedItem = Nothing
End With
End Sub
'-------------------------------------------------------------------------------------
' Module : usfAffichage/entete
' DateTime : 28/04/2008 / 18:53
' Auteur : JP14
' Utilisation : créer une listeview
'-------------------------------------------------------------------------------------
Private Sub entete(£nu As Integer, £donne As Variant)
Dim £i As Integer

With Me.Controls("Listview" & £nu)

With .ColumnHeaders

.Clear 'Supprime les anciens entêtes
For £i = LBound(£donne) To UBound(£donne) Step 2
.Add , , CStr(£donne(£i)), CLng(£donne(£i + 1))
Next £i
End With
End With
End Sub

en esperant que sa peut aider comme cela ???
merci

Re

Oui ça peut aider ... mais avec le message d'erreur ça aiderait bien aussi ...

Ceci n'est pas obligatoire : DTPicker2.Value = Format(Now, "dd/mm/yyyy") ... DTPicker2.Value = Now suffit. Le format date "dd/mm/yyyy" est celui par défaut du DTPicker.

;o)