Format date transfert userform vers feuille

Résolu
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

  • Votes
  • Date
  • Date décroissante
  1. pijaku Modérateur
    Bonjour,
    lors du transfert userform sur la feulle utilisez la syntaxe : 
    Range("blabla") = CDate(pvtra)
    1. patrick141078
      ok merci cel fonctionne
    2. pijaku Modérateur
      de rien,
      Au plaisir
    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
  2. pijaku Modérateur
    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!
    1. 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
      1. pijaku Modérateur
        ça fonctionne ou pas?
        Si ça ne fonctionne pas, prière de nous dire ou et quel est le message d'erreur...
    2. 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
      1. pijaku Modérateur
        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

    Discussions similaires

    transferer des photos du redmi note 14 sur un pc
    pralvan

    2 réponses
    Transférer les photos de mon REDMI sur mon ordinateur
    SOSProvidence

    15 réponses