Autres Saisie par userform

[KRUG WOO]

Bonsoir les amis,
j'ai un fichier que j'aimerai automatiser les saisies des données par userform: valider, supprimer, modifier.
j'utilise le Range("nom du tableau").ListObject.ListRows.Add.Range.... mais ne marche pas, peut être qu'il faut utiliser activecell.entireRow.select ou activecell.entireColumn.select pour que ça marche, enfin je crois
J'espère que je ne fais pas de bêtises pour les structures
Merci

 

[patricktoulon]

bonjour à tous
@Jacky67

Private Sub Naissance_Change()
    Select Case Len(Naissance.Text)
    Case 2, 5
        Naissance.Text = Naissance.Text & "/"
    End Select
End Sub

serieux?
essaie la touche back pour voir ?

 

[patricktoulon]

re
essayez plutot ça

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim V
    V = TextBox1.Value    'récupération de la valeur du textbox
    Select Case KeyCode
    Case 48 To 57    'clavier numerique en haut du clavier
    Case 96 To 105: KeyCode = KeyCode - 48    'pavé numerique à droite
    Case 8, 46    ' touche back et suppr
        Exit Sub
    Case Else: KeyCode = 0    'toutes les autre touches seront bloquées
    End Select
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "\"    'si on est en len 2 ou 5 avant la touche  le separateur est mis en place
    V = V & Chr(KeyCode)    'on ajoute le caracteres
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "\"    'si le nen =2 ou 5 après la touche on met le séparateur
    KeyCode = 0    'et on anule enfin la touche
    'on pourait ajouter le control de validité de la date ici pour V avant le mettre dans le textbox
    TextBox1 = V    'le textbox = V tout simplement
'terminé vous avez un datebox
'mais vous avez la possibilité d'effacer et revenire avec la touche back
End Sub

 

[ChTi160]

Bonsoir le Fil!
@patrick , est-ce normal que tu es mis "\" comme séparateur, plutôt que "/" dans la procédure ?
Bonne Fin de Journée
jean marie

 

[Jacky67]

bonjour à tous
@Jacky67

Private Sub Naissance_Change()
    Select Case Len(Naissance.Text)
    Case 2, 5
        Naissance.Text = Naissance.Text & "/"
    End Select
End Sub

serieux?
essaie la touche back pour voir ?

Hello patrick
C'était pour pas compliquer
Perso, je mettrais un calendrier, je dirais même ..... le tien

 

[patricktoulon]

@Jacky67
ben oui mais qui dit pas compliqué dit bloquage du textbox en cas d'erreur
on ne peut plus rattraper

@ChTi160
oui c'est une erreur ,j'ai fait ça à toute vitesse

 

[Eric C]

Bonsoir le forum
Bonsoir le fil.

@ Patrick : pourrais-tu, s'il te plait, ajouter la vérif de validité de la date dans le code que tu as mis à notre disposition car je n'y parviens pas (essais infructueux avec If Not IsDate...). Merci d'avance.

Bonne soirée à toutes & à tous.
Eric c

 

[Jacky67]

@Jacky67
ben oui mais qui dit pas compliqué dit bloquage du textbox en cas d'erreur
on ne peut plus rattraper

Re..
Je n'ai aucun blocage, le texbox reste modifiable, certes, il faut sélectionner....
Il y a tout de même une utilisation plus complète entre le classeur #1 et classeur #9
Allez....ne chipote pas
Libre à l'utilisateur d'y ajouter un calendrier.... ou pas
Moi, je retourne finir ma tisane.

 

[ChTi160]

Bonsoir le Fil
J'ai aussi pensé au besoin de mettre un control du nombre de caractères saisie max 10 (Patrick a du le faire dans un autre fil) Genre If Len(V)=10 Then KeyCode=0
Depuis mon téléphone
Jean marie

 

[patricktoulon]

re
re je chipote pas je t'assure c'est chiant de devoir reprendre la souris re selectionner tout , et effacer
surtout que la plus part du temps je me debrouille pour qu'une fois dans le premier champs à remplir avec enter ou tab je vais de champs en champ

@ChTi160 pas besoins du if
rend la chose catégorique

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim V
    V = TextBox1.Value    'récupération de la valeur du textbox
    Select Case KeyCode
    Case 48 To 57    'clavier numerique en haut du clavier
    Case 96 To 105: KeyCode = KeyCode - 48    'pavé numerique à droite
    Case 8, 46    ' touche back et suppr
        Exit Sub
    Case Else: KeyCode = 0    'toutes les autre touches seront bloquées
    End Select
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "/"    'si on est en len 2 ou 5 avant la touche  le separateur est mis en place
    V = V & Chr(KeyCode)    'on ajoute le caracteres
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "/"    'si le nen =2 ou 5 après la touche on met le séparateur
    KeyCode = 0    'et on anule enfin la touche
    'on pourait ajouter le control de validité de la date ici pour V avant le mettre dans le textbox
    TextBox1 = Mid(V, 1, 10)  'le textbox = V tout simplement(10 caractères )
'terminé vous avez un datebox
'mais vous avez la possibilité d'effacer et revenire avec la touche back
End Sub

 

[ChTi160]

Re

Mid(V, 1, 10)

Laisse donc la possibilité de saisir plus de 10 caractères,seuls 10 seront pris en compte ?

 

[Eric C]

Re le fil
En cherchant un peu, j'ai déniché ceci qui semble bien :

Option Explicit     'archer

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 8 Then
        If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1)
    ElseIf KeyCode = 46 Then TextBox1 = ""
    End If
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode < 96 Or KeyCode > 105 Then
        If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
    End If
    Select Case Len(TextBox1.Text)
    Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "jour trop grand" Else TextBox1 = TextBox1 & "/"
    Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "mois  trop grand" Else TextBox1 = TextBox1 & "/"
    Case 10: If Not IsDate(TextBox1) Then MsgBox "tu veux une claque ou quoi?" & vbCrLf & " Ou tu as vu que ce jour existe dans le calendrier" & vbCrLf & " allez recommence!!!": TextBox1 = ""
    Case 11: TextBox1 = Mid(TextBox1, 1, 10)
    End Select
End Sub

Bonne soirée à toutes & à tous et bon appétit
Eric c

 

[patricktoulon]

re
bonsoir eric ya du bibi la dedans
cela dit c'est une version tronqué de mes exemple sur excel pratique
elle est incomplete puisqu'elle ne gère pas le clavier numerique haut

le pire c'est qu'il y a encore mes msgbox delire
et je prenais le keyup parce que je savais pas géré l'avant/apres
maintenant oui dans le keydown

pourquoi il est toujours redistribué ce que je fait de moins bien ?

 

[Eric C]

Bonjour le forum
Bonjour le fil

@ Patrick : c'était simplement en attendant ta version finalisée

Bonne journée à toutes & à tous
Eric c

 

[patricktoulon]

re
tu l'a jamais eu ?

Sub ControlDate(TxTB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
'datebox patricktoulon
    Dim V
    V = TxTB.Value
    Select Case KeyCode
    Case 48 To 57, 96 To 105: If KeyCode > 57 Then KeyCode = KeyCode - 48
    Case 8, 46: Exit Sub
    Case 13, 9: If Len(V) < 10 Then KeyCode = 0: Exit Sub
    Case 27: TxTB = "": KeyCode = 9: Exit Sub
    Case Else: KeyCode = 0
    End Select
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "/"
    V = V & Chr(KeyCode)
    Select Case Len(V)
    Case 1: If V > 3 Then V = ""
    Case 2, 3: If Val(V) > 31 Then V = ""
    Case 5: If Not IsDate(V & "/2000") Then V = Left(V, 3)
    Case 10: If Not IsDate(V) Then V = Left(V, 6)
    End Select
    If Len(V) = 2 Or Len(V) = 5 Then V = V & "/"
    KeyCode = 0
    TxTB = Mid(V, 1, 10)  '
End Sub


Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ControlDate TextBox1, KeyCode
End Sub

 

[Eric C]

Re le fil

En cherchant un peu dans mes archives, j'ai retrouvé ceci :

Option Explicit   

'********************************************************************
'           TEXTBOX FORMATE AVEC MASQUE DE SAISIE DYNAMIQUE
'Auteur patricktoulon sur exceldownload
'Version 2019/2020
'utilisation de l'interception du keycode dans le keydown
'les 3 formats de date géré par excel * le nombre de separateurs possible et caractere du masque
'*********************************************************************

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$
    
     If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier
 
 
    '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 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 Exit Function
        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


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

Bonne journée à toutes & à tous
Eric c