Format date transfert userform vers feuille

Résolu
patrick141078 -  
 patrick141078 -
Bonjour,
Dans la textbox avec le code ci dessous je "formate" comme ceci 10/01/2012
lors du transfert userform sur la feulle j'ai très souvent 01/10/2012

Private Sub pvtra_Change()
Dim Valeur As Byte
pvtra.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
Valeur = Len(pvtra)
If Valeur = 2 Or Valeur = 5 Then pvtra = pvtra & "/"
End Sub

j'ai supprimer le code ci dessus et remplacé par celui ci mais j'ai toujours le même pb
Private Sub pvtra_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim no_ligne As Integer, nom

With Me.pvtra
.Value = Application.Proper(Format(.Value, "DD/MM/YYYY"))

End With
End Sub

5 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,
    lors du transfert userform sur la feulle utilisez la syntaxe : 
    Range("blabla") = CDate(pvtra)
    0
    1. patrick141078
       
      ok merci cel fonctionne
      0
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      de rien,
      Au plaisir
      0
    3. patrick141078
       
      sauf que j'ai fait un essai en remplissant toutes les texbox qui contiennent une date
      Effet j'ai plusieurs textbox ou je mets des dates je les transfere comme tu m'as indiqué mais j'ai des situations ou je ne suis pas obligé de remplir l'ensemble des textbox et là lors du transfert j'a un message d'erreur " erreur d'exécution 13 incompatibilité de type" et si je remplis les textbox dont je n'ai pas besoin avec un 0 cela fonctionne si tu peux m'indiquer la solution merci
      0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    A ce moment, il te faut tester le contenu de chaque textbox :
    Par exemple : en sortie de chacun : 
    Private Sub pvtra_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
If pvtra = "" Then pvtra = 0 
End Sub

    Soit dans le code du bouton : 
    If pvtra <> "" Then Range("blabla") = CDate(pvtra)

    La 2nde solution est encore la + simple à mettre en oeuvre et la plus adaptée à ta situation. En effet, si tu as 20 textbox, il te faut ajouter autant de procédures Exit que de textbox... Ou alors passer par un module de classe...
    A voir!
    0
  3. patrick141078
     
    re bonjour et merci pour votre aide et patience, ce n'est pas un secret mais je suis vraiment un novice en la matière ne maîtrise pas tout ( pour pas dire grand chose)

    je ne sais pas à quoi sert un module de classe et j'ai essayé de placer les codes indiqués mais (mal vraisemblablement) j'ai toujours des pb

    ou j'en suis:

    dans le textbox pvtra j'ai mis le code suivant

    Private Sub pvtra_Change()
    Dim Valeur As Byte
    pvtra.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(pvtra)
    If Valeur = 2 Or Valeur = 5 Then pvtra = pvtra & "/"

    sur le code bouton

    j'ai outre les codes de mgs d'erreurs pour remplir obligatoirement certains textbox,
    If Me.pvtra = "" Then
    MsgBox "Le champ date de traitement est obligatoire"
    Me.pvtra.SetFocus
    Exit Sub
    End If
    les frames boutons options,

    une ligne code pour intégrer les données saises dans l'userform sur la première ligne vide de la feuille comme ceci

    no_ligne = Range("A65536").End(xlUp).Row + 1

    puis
    Cells(no_ligne, 9) = CDate(pvtra)

    merci encore
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      ça fonctionne ou pas?
      Si ça ne fonctionne pas, prière de nous dire ou et quel est le message d'erreur...
      0
  4. patrick141078
     
    bonjour
    sur mon premier pb la solution que tu as donné fonctionne
    "lors du transfert userform sur la feulle utilisez la syntaxe :
    Range("blabla") = CDate(pvtra)    "

    par contre en mettant de code partout ou je dois mettre une date le message suivant apparait lors d'un tranfert userform vers feuille

    message: erreur d exécution '13' incompatibilté de type sur la ligne
    cells (no_ligne, 24)= CDate(pvmai)

    cette erreur disparaît si je mets un 0 dans le textbox correspondant à pvmai

    ci joint le code bouton ajouter de mon userform:
    Private Sub pvajo_Click()
    Dim no_ligne As Integer, nom

    If Me.pvref = "" Then
    MsgBox "Le champ commune est obligatoire"
    Me.pvcom.SetFocus
    Exit Sub
    End If
    If Me.pvcom = "" Then
    MsgBox "Le champ commune est obligatoire"
    Me.pvref.SetFocus
    Exit Sub
    End If
    If Me.pvnum = "" Then
    MsgBox "Le champ N° de PV est obligatoire"
    Me.pvnum.SetFocus
    Exit Sub
    End If
    If Me.pvrefext = "" Then
    MsgBox "Le champ référence extérieure est obligatoire"
    Me.pvrefext.SetFocus
    Exit Sub
    End If
    If Me.pvrec = "" Then
    MsgBox "Le champ date réception est obligatoire"
    Me.pvrec.SetFocus
    Exit Sub
    End If
    If Me.pvdem = "" Then
    MsgBox "Le champ date demande est obligatoire"
    Me.pvdem.SetFocus
    Exit Sub
    End If
    If Me.pvtra = "" Then
    MsgBox "Le champ date de traitement est obligatoire"
    Me.pvtra.SetFocus
    Exit Sub
    End If
    If Me.pvnumrd = "" Then
    MsgBox "Le champ N° RD est obligatoire"
    Me.pvnumrd.SetFocus
    Exit Sub
    End If
    If Me.pvprd = "" Then
    MsgBox "Le champ PR début est obligatoire"
    Me.pvprd.SetFocus
    Exit Sub
    End If
    If Me.pvprf = "" Then
    MsgBox "Le champ PR fin est obligatoire"
    Me.pvprf.SetFocus
    Exit Sub
    End If
    If Me.pvobjcom = "" Then
    MsgBox "Le champ complément/détails de la PV est obligatoire, sinon indiquer néant"
    Me.pvobjcom.SetFocus
    Exit Sub
    End If
    If Me.pvobjpre = "" Then
    MsgBox "Le champ prescriptions est obligatoire"
    Me.pvobjpre.SetFocus
    Exit Sub
    End If

    no_ligne = Range("A65536").End(xlUp).Row + 1

    If Optcat1 = False And Optcat2 = False And Optcat3 = False And Optcat4 = False And optcatrgc = _
    False Then MsgBox "catégorie: faire un choix": Exit Sub

    If Optcat1 Then 'Si coché ...
    Cells(no_ligne, 14) = "1ère"
    ElseIf Optcat2 Then 'Si coché ...
    Cells(no_ligne, 14) = "2ème"
    ElseIf Optcat3 Then 'Si coché ...
    Cells(no_ligne, 14) = "3ème"
    ElseIf Optcat4 Then 'Si coché ...
    Cells(no_ligne, 14) = "4ème"
    ElseIf optcatrgc Then 'Si coché ...
    Cells(no_ligne, 14) = "RGC"
    Else
    Cells(no_ligne, 14) = "non coché"
    End If

    If Optcotdro = False And Optcotgau = False And Optcotdrogau = False Then MsgBox "Coté: faire un choix": Exit Sub

    If Optcotdro Then 'Si coché ...
    Cells(no_ligne, 15) = "droit"
    ElseIf Optcotgau Then 'Si coché ...
    Cells(no_ligne, 15) = "gauche"
    ElseIf Optcotdrogau Then 'Si coché ...
    Cells(no_ligne, 15) = "droit & gauche"
    Else
    Cells(no_ligne, 15) = "non coché"
    End If

    If Optsitagg = False And optsithag = False And optsitaha = False Then MsgBox "situation: faire un choix": Exit Sub

    If Optsitagg Then 'Si coché ...
    Cells(no_ligne, 18) = "en agglomération"
    ElseIf optsithag Then 'Si coché ...
    Cells(no_ligne, 18) = "hors agglomération"
    ElseIf optsitaha Then 'Si coché ...
    Cells(no_ligne, 18) = "en & hor agglomération"
    Else
    Cells(no_ligne, 18) = "non coché"
    End If

    If optpvtypele = False And optpvtypeau = False And optpvtypgaz = False And optpvtyptel = _
    False And optpvtypmul = False And optpvtypvoi = False And optpvtypali = _
    False And optpvtyptra = False And optpvtypred = False Then MsgBox " type de PV: faire un choix": Exit Sub

    If optpvtypele Then 'Si coché ...
    Cells(no_ligne, 4) = "PV ELECTRICITE"
    ElseIf optpvtypeau Then 'Si coché ...
    Cells(no_ligne, 4) = "PV AEP ET\OU EU"
    ElseIf optpvtypgaz Then 'Si coché ...
    Cells(no_ligne, 4) = "PV GAZ"
    ElseIf optpvtyptel Then 'Si coché ...
    Cells(no_ligne, 4) = "PV TELEPHONE"
    ElseIf optpvtypmul Then 'Si coché ...
    Cells(no_ligne, 4) = "PV MULTI RESEAUX"
    ElseIf optpvtypvoi Then 'Si coché ...
    Cells(no_ligne, 4) = "PV TX VOIRIE"
    ElseIf optpvtypali Then 'Si coché ...
    Cells(no_ligne, 4) = "PV ALIGNEMENT"
    ElseIf optpvtyptra Then 'Si coché ...
    Cells(no_ligne, 4) = "PV TRAVAUX DIVERS"
    ElseIf optpvtypred Then 'Si coché ...
    Cells(no_ligne, 4) = "PERMISION VOIRIE REDEVANCE"
    Else
    Cells(no_ligne, 4) = "non coché"
    End If

    If Me.pvdem.Value = "" Then
    Me.pvdem.Value = " "
    End If
    If Me.pvrec.Value = "" Then
    Me.pvrec.Value = " "
    End If
    If Me.pvtra.Value = "" Then
    Me.pvtra.Value = " "
    End If
    If Me.pvmai.Value = "" Then
    Me.pvmai.Value = " "
    End If

    'Insertion des valeurs sur la feuille
    Cells(no_ligne, 1) = pvref.Value
    Cells(no_ligne, 3) = pvcom.Value
    Cells(no_ligne, 5) = pvnum.Value
    Cells(no_ligne, 6) = pvrefext.Value
    Cells(no_ligne, 7) = CDate(pvdem)
    Cells(no_ligne, 8) = CDate(pvrec)
    Cells(no_ligne, 9) = CDate(pvtra)
    Cells(no_ligne, 10) = pvcadsec.Value
    Cells(no_ligne, 11) = pvcadpar.Value
    Cells(no_ligne, 12) = "RD"
    Cells(no_ligne, 13) = pvnumrd.Value
    Cells(no_ligne, 16) = pvprd.Value
    Cells(no_ligne, 17) = pvprf.Value
    Cells(no_ligne, 19) = pvdemcon.Value
    Cells(no_ligne, 20) = pvparnom.Value
    Cells(no_ligne, 21) = pvobjcom
    Cells(no_ligne, 22) = pvobjpre.Value
    Cells(no_ligne, 23) = pvobjprecom.Value
    Cells(no_ligne, 24) = CDate(pvmai)
    Cells(no_ligne, 103) = pvparciv.Value
    Cells(no_ligne, 104) = pvparnom.Value
    Cells(no_ligne, 109) = pvparadr.Value
    Cells(no_ligne, 110) = pvparcp.Value
    Cells(no_ligne, 111) = pvparcom.Value

    pvref.Value = ""
    pvcom.Value = ""
    pvnum.Value = ""
    pvrefext.Value = ""
    pvrec.Value = ""
    pvdem.Value = ""
    pvtra.Value = ""
    pvnumrd.Value = ""
    pvprd.Value = ""
    pvprf.Value = ""
    pvobjcom.Value = ""
    pvobjpre.Value = ""
    pvobjprecom.Value = ""
    pvparciv.Value = ""
    pvparnom.Value = ""
    pvparadr.Value = ""
    pvparcp.Value = ""
    pvparcom.Value = ""
    pvmai.Value = ""
    pvcadsec.Value = ""
    pvcadpar.Value = ""

    End Sub

    Mes texbox dates contiennent le code type
    Private Sub pvmai_Change()
    Dim Valeur As Byte
    pvmai.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(pvmai)
    If Valeur = 2 Or Valeur = 5 Then pvmai = pvmai & "/"
    End Sub

    merci pour ton aide
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Bonjour,
      par contre en mettant de code partout ou je dois mettre une date le message suivant apparait lors d'un tranfert userform vers feuille
      message: erreur d exécution '13' incompatibilté de type sur la ligne
      cells (no_ligne, 24)= CDate(pvmai)

      Si pvmai n'est pas saisi, pvmai = "" rien, pas zéro.
      Une date ne peux pas être rien...
      Donc il te faut soit remplir tout tes textbox, soit faire un test en "envoyant" son contenu dans la cellule : 
      If pvmai = "" Then
    cells (no_ligne, 24)= pvmai 'ou = 0 ou ce que tu veux!
ElseIf IsDate(pvmai) Then
    cells (no_ligne, 24)= CDate(pvmai)
End If
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. patrick141078
     
    Ok f
    je vois merci
    à plus
    0

Discussions similaires

transferer des photos du redmi note 14 sur un pc
pralvan -
Philippe -

2 réponses
Code de renvoi d'appel : Ooredo, Mobilis...
midoou07 -
Camille -

13 réponses