excel dtpicker probleme

Question

Bonjour,

je suis en train de realiser un fichier client sur excel ! j'ai utiliser un dtpicker sur une macro ! mais j'en ai besoin de 3  pour 3 macros ! mais a chaque sa bug !!! on ne peut utiliser qu'un seul dtpicker ?????????

Polux31 · Answer

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)

tchatcheur01 · Answer

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

Polux31 · Answer

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)

Excel dtpicker probleme

3 réponses

Votre réponse

Newsletters