Saisie automatique

Commenter

Contenu du snippet

Ce module permet de saisir automatiquement dans des TextBox.
Dès que la longueur maximum d'une TextBox est atteinte (propriété Maxlength), il y a passage automatique à la TextBox suivante.
Le passage à la TextBox suivante peut aussi se faire par la touche Tab.
Un code permet de contrôler la saisie :
A = caractères alphanumériques
C = caractères numériques avec 1 décimale égale à 5
0 = caractères numériques sans décimales
1àn = caractères numériques avec 1 à n décimales
H = caractères numériques à 2 décimales (maximum 59 - type horaire)
L'appel se fait dans l'évenement KeyPress de chaque TextBox:
Saisie Keyascii, "code"

Source / Exemple : 


Public Sub Saisie(Tou, Typ As String)
  Dim Heur As Boolean
  Dim Cong As Boolean
  If Tou = 8 Then Exit Sub
  If Screen.ActiveControl.SelText <> "" Then
    If Screen.ActiveControl.SelStart = 0 Then
      Screen.ActiveControl.Text = Right(Screen.ActiveControl.Text, Len(Screen.ActiveControl.Text) - Screen.ActiveControl.SelLength)
     Else
      If Screen.ActiveControl.SelStart = Len(Screen.ActiveControl.Text) - 1 Then
        Screen.ActiveControl.Text = Left(Screen.ActiveControl.Text, Screen.ActiveControl.SelStart)
        Screen.ActiveControl.SelStart = Len(Screen.ActiveControl.Text)
       Else
        ResStart = Screen.ActiveControl.SelStart
        Screen.ActiveControl.Text = Left(Screen.ActiveControl.Text, Screen.ActiveControl.SelStart) + Right(Screen.ActiveControl.Text, Len(Screen.ActiveControl.Text) - Screen.ActiveControl.SelStart - Screen.ActiveControl.SelLength)
        Screen.ActiveControl.SelStart = ResStart
      End If
    End If
  End If
  Cong = False
  Heur = False
  If Typ <> "A" Then
    If Typ = "C" Then
      Typ = 1
      Cong = True
     Else
      If Typ = "H" Then
        Typ = 2
        Heur = True
       Else
        If Typ = "-H" Then
          Typ = -2
          Heur = True
         Else
          If Not IsNumeric(Typ) Then
            If MsgBox("Le type de données " & Typ & " est invalide", 16, "Procédure de saisie") = vbOK Then
              Tou = 0
              Exit Sub
            End If
          End If
        End If
      End If
    End If
    If Typ <> 0 Then
      If Typ > 0 Then
        If (Chr(Tou) < "0" Or Chr(Tou) > "9") And Chr(Tou) <> "." Then
          Tou = 0
          Beep
          Exit Sub
        End If
       Else
        If (Chr(Tou) < "0" Or Chr(Tou) > "9") And (Chr(Tou) <> "." And Chr(Tou) <> "-") Then
          Tou = 0
          Beep
          Exit Sub
        End If
        If Chr(Tou) = "-" Then
          If Len(Screen.ActiveControl) <> 0 Then
            Tou = 0
            Beep
            Exit Sub
          End If
        End If
      End If
      A = InStr(1, Screen.ActiveControl, ".")
      If Chr(Tou) = "." Then
        If A > 0 Then
          Tou = 0
          Beep
          Exit Sub
        End If
      End If
      If A > 0 Then
        If Cong And Screen.ActiveControl.SelStart >= A And Chr(Tou) <> "5" Then
          Tou = 0
          Beep
          Exit Sub
        End If
        If Heur And Screen.ActiveControl.SelStart = A And Chr(Tou) > "5" Then
          Tou = 0
          Beep
          Exit Sub
        End If
      End If
      If A > 0 And Screen.ActiveControl.SelStart >= A And Len(Screen.ActiveControl) - A = Typ Then
        Tou = 0
        Beep
        Exit Sub
      End If
     Else
      If Chr(Tou) < "0" Or Chr(Tou) > "9" Then
        Tou = 0
        Beep
        Exit Sub
      End If
      If Chr(Tou) = "." Then
        Tou = 0
        Beep
        Exit Sub
      End If
    End If
  End If
  If Len(Screen.ActiveControl) + 1 >= Screen.ActiveControl.MaxLength Then SendKeys "{TAB}{END}", True
End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_pitch)