Autres remplir bd depuis userform

[maxim47]

Bonsoirr
je cherche à remplir une petite base de données depuis un userform jai essayé depuis d'autres exemples mais je n'y arrive pas si quelqu'un peut me donner un coup de main
merci d'avance out est dans le fichiers joint

 

[JM27]

Bonsoir
A tester

 

[jcf6464]

Bonsoir Maxim47 et le forum,

Déjà supprime et change tes listebox par des textbox

a+ bonne continuation

jcf6464

oups Jm27 remis message en même temps

 

[JM27]

rectificatif
attention la saisie des dates se fait sans le/ et sans le premier 20 de 2020
uniquement jjmmaa

 

[maxim47]

merci beaucoup c'est ce que je cherchai mais pour ma bd je n'ai besoin que de la première ligne il faudrait l'effacer avant de rentrer les données si c'est possible, ensuite quand on valide l'userbox ne se referme pas et en dernier comment puis je faire pour lancer une macro quand je valide.
merci encore
Maxim

 

[JM27]

Bonjour
correction selon ce que tu souhaites .
par contre

comment puis je faire pour lancer une macro quand je valide.

Je ne comprends pas.
Tu l'as déjà ta macro qui se lance à la validation
elle s'appelle
Private Sub CmbValider_Click()
il faudrait pour ta formation essayer de lire et comprendre ce que j'ai écrit
Pour info : une base de donnée qui n'a qu'une ligne n'est pas une base de donnée!

 

[JM27]

Ou encore cela , mais je ne vois pas l’intérêt

 

[patricktoulon]

bonjour
bien le control de date mais ca n'est pas ergonomique
si je tape par exemple 31 et que je change d'avis parce que je me suis trompé je voulais taper 30 ben je suis bloqué(essayez) et pareil pour le mois

vu que le "/" est ajouté automatiquement
et même si vous tapez 31/02/20 l'erreur est relevée qu'a ce moment la alors que 31/02 devrait etre détecté



ce que fait ceci
celui ci de control est vraiment ergonomique et ne te condamne pas les touches back et supp ou autre
il procède par Controle des touches et validité de date théorique jusqu'a date complete et il accepte tout separateurs et les 3 formats de date le tout reste dans le userform

Public Function control_keydown(tdat As Object, KeyCode, Optional mask As String = "dd/mm/yyyy", Optional charMASK As String = "_")
'MsgBox KeyCode
    Dim txt$, X&, plus&, longg&, sep$, mask2$
    'construction du masque de saisie(mask2) en fonction de la chaine de format de date injectée
    mask2 = Replace(Replace(Replace(mask, "d", charMASK), "m", charMASK), "y", charMASK)
    sep = Left(Replace(mask2, charMASK, ""), 1) 'determine le caractere de separation
    If tdat = "" Then tdat = mask2    'si textbox vide alors = mask2
    txt = tdat.Value: If txt = mask2 Then tdat.SelStart = 0: tdat = ""
    X = tdat.SelStart: longg = tdat.SelLength: If longg = 0 Then longg = 1
    If KeyCode = 8 And longg > 1 Then KeyCode = 46
    Select Case KeyCode
    Case 96 To 105
        If X = 10 Then KeyCode = 0: Exit Function
        If Mid(mask2, X + 1, 1) = sep Then X = X + 1
        Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): tdat = txt: plus = IIf(KeyCode < 96, 32, -48):    'reformate si plus de 1 caractere selectionné
        Mid(txt, X + 1, 1) = Chr(KeyCode + plus): tdat = txt: tdat.SelStart = X + 1: KeyCode = 0
        If Mid(tdat, X + 2, 1) = sep Then tdat.SelStart = X + 2

        'control de validité de la date tapée a tout moment
        Dim Pos1&, Pos2&, Part1$, Part2$, Part3$, PosX&
        Select Case True    'determine les segment jours/mois/année  et les positions selstart SELON le format injecté
        Case Left(mask, 2) = "yy": Part2 = Mid(tdat, 6, 2): Part1 = Mid(tdat, 9, 2): Part3 = Mid(tdat, 1, 4): Pos1 = 8: Pos2 = 5: PosX = 8
        Case Left(mask, 2) = "mm": Part2 = Mid(tdat, 1, 2): Part1 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos2 = 0: Pos1 = 3: PosX = 3
        Case Left(mask, 2) = "dd": Part1 = Mid(tdat, 1, 2): Part2 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos1 = 0: Pos2 = 3: PosX = 3
        End Select

        'on ne peut depasser 31 pour les jours et 12 pour le mois quelque soit le format
        If Val(Part1) > 31 Or Val(Left(Part1, 1)) > 3 Or Part1 = "00" Then tdat.SelStart = Pos1: tdat.SelLength = 2: Beep: Exit Function
        If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 = "00" Then tdat.SelStart = Pos2: tdat.SelLength = 2: Beep: Exit Function

        'quand jour et mois sont rempli on teste avec l'annéee 2000(année bissextile pour fevrier)et 30 ou 31 pour les autres mois
        If IsDate(Part1 & "/" & Part2) Then If Not IsDate(Part1 & "/" & Part2 & "/2000") Then tdat.SelStart = PosX: tdat.SelLength = 2: Beep

        If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then    'si plus de caracteres mask on teste la date complete
            tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep: Exit Function
        Else
            'pour pallier a l'erreur(limite 1900 d'excel) de isdate pour les année inferieur a 100 pour fevrier
            If IsDate(tdat) Then If Year(CDate(tdat)) <> Val(Part3) Then tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep
        End If

    Case 8    'touche BACK (Retour en arrière)
        If X <> 0 Then Mid(txt, X, longg + 1) = Mid(mask2, X, longg + 1)
        tdat = txt: tdat.SelStart = X - 1: KeyCode = 0
        If tdat = mask2 Then tdat = ""
        If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then tdat.SelStart = X - 2
    Case 46 'touche Suppr(supprimer)
    Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode = 0: tdat = txt: tdat.SelStart = X    'touche Suppr

    Case 37: tdat.SelStart = X - 1    'touche fleche gauche
    Case 39: tdat.SelStart = X + 1    'touche fleche droite

    Case 13 Or 9    ' ce que l'on veux c'est la sortie

    Case Else: KeyCode = 0    'touche les autres touches sont exclues
    End Select

End Function

et pour le textbox quelques exemples d'appel

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox1, KeyCode, "yyyy-mm-dd", "_"
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox2, KeyCode, "mm/dd/yyyy", "_"
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox3, KeyCode, "dd/mm/yyyy", "_"
End Sub

Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox4, KeyCode
End Sub
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox5, KeyCode, "dd mm yyyy"
End Sub

voila control de validité et souplesse d'utilisation

 

[JM27]

Bonjour et merci pour le conseil , mais je vais surement installer si il me le demande un genre detPicker ( vachement bien) que je viens de regarder
dont l'origine est :::
est :::
est :
patricktoulon

en plus j'apprécie les commentaires dans tes macros

 

[patricktoulon]

Bonjour JM27
oui le calendar (il fait parler de lui en ce moment ) mais la on est juste dans le controle de saisie dans textbox
teste tu verra comme c'est quand même plus souple qu'avec le controle dans l’événement change (post saisie)

tape des erreurs ,change d'avis, etc....

 

[JM27]

Je me doute que ton contrôle est bien supérieure
( je n'ai pas voulu me casser trop la tête)

edit: je viens de regarder ton contrôle de date , c'est franchement pas mal
mais je préfère le calendar

 

[patricktoulon]

Je me doute que ton contrôle est bien supérieure
( je n'ai pas voulu me casser trop la tête)

c'est dommage que tu veuille pas te casser la tete car il y a moyen avec une variable static de libérer la touche back et autre ton model serait beaucoup mieux

 

[JM27]

si tu le souhaites
cela serait bien de me fournir un exemple avec mon contrôle et ta variable static ( je ne vois pas )
une suggestion : installer des dates mini et maxi de saisie

 

[patricktoulon]

re
comme ca en gros a peaufiner (bien sur)

Private Sub TextBox1_Change()
    Static t As String
    With TextBox1
        If Len(.Value) > Len(t) Then
            If Val(.Value) > 31 Then .Value = ""
            If Len(.Value) = 2 Or Len(.Value) = 5 Then .Value = .Value & "/"
            If Len(.Value) = 6 Then If Not IsDate(.Value & "2000") Then .SelStart = 3: .SelLength = 3: Beep

        Else


        End If

        t = .Value
    End With
End Sub

tu peux changer d'avis en cours de route et effacer et retaper
reste encore des truc a faire c'est pas au point je t'ai tapé ca en 2 secondes

 

[patricktoulon]

re
peut etre comme ca

Private Sub TextBox1_Change()
    Static t As String
    With TextBox1
        If Len(.Value) > Len(t) Then
            If Val(.Value) > 31 Then .SelStart = 0: .SelLength = 3: Beep
            If Len(.Value) = 2 Or Len(.Value) = 5 Then .Value = .Value & "/"
            If Len(.Value) = 6 Then If Not IsDate(.Value & "2000") Then .SelStart = 3: .SelLength = 3: Beep

        Else
         If Len(.Value) = 2 Then .Value = ""
         If Len(.Value) > 6 Then .Value = Left(t, 6)
         If Len(.Value) > 3 Then .Value = Left(t, 3)

        End If

        t = .Value
    End With
End Sub

l'erreur est relevée par un beep et la partie en erreur est sélectionnée donc des que tu va retaper pour corriger ca va s'effacer tout seul

si tu tape 32 ou plus ca donne 32/ et le tout selectionné
si tu tape 31/25 ca donne 31/25/ et la partie en erreur (mois +"/" est selectionnée

quand tu efface avec la touche back tu supprime segment par segment
c'est juste une approche

reconnais que c'est quand même plus simple et plus ergonomique a l'utilisation que d'etre bloqué en cas d'erreur ou ne pas pouvoir changer d'avis en cours de route