format date transfert userform vers feuille Résolu/Fermé

Question

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


Configuration: Windows Vista / Safari 535.7

pijaku · Answer

Bonjour,
lors du transfert userform sur la feulle utilisez la syntaxe :
Range("blabla") = CDate(pvtra)

pijaku · Answer

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!

patrick141078 · Answer

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

patrick141078 · Answer

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

patrick141078 · Answer

Ok f
je vois merci
à plus

Format date transfert userform vers feuille

5 réponses

Discussions similaires