Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres remplir bd depuis userform

maxim47

XLDnaute Nouveau
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
 

Pièces jointes

  • userbox.xlsm
    43.2 KB · Affichages: 16

JM27

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

Pièces jointes

  • userbox.xlsm
    56.1 KB · Affichages: 13
Dernière édition:

maxim47

XLDnaute Nouveau
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

XLDnaute Barbatruc
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!
 

Pièces jointes

  • userbox.xlsm
    56.3 KB · Affichages: 6
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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


VB:
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

Code:
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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....
 

Pièces jointes

  • newwboxdate2019 2020.xlsm
    21.9 KB · Affichages: 20

JM27

XLDnaute Barbatruc
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
 

JM27

XLDnaute Barbatruc
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
comme ca en gros a peaufiner (bien sur)
VB:
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

XLDnaute Barbatruc
re
peut etre comme ca
Code:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…