Index

Numérique avec décimales
Code Postal
Saisie Dates
Saisie Heures
Masque Saisie Date
Masque saisie Siret

Numérique avec décimales

SaisieNumérique.xls

Sur cet exemple, nous autorisons seulement la saisie des chifres 012...0 et du séparateur de décimales.

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If InStr("0123456789,", Chr(KeyAscii)) = 0 Then
   KeyAscii = 0
   Beep
 End If
End Sub

Saisie code postal

Nous autorisons seulement la saisie de chiffres

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
     KeyAscii = 0
     Beep
   End If
End Sub

Nous nous assurons que le nombre de chiffres saisie est bien égalà 5.

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  If Len(Me.TextBox2) > 0 Then
      If Len(Me.TextBox2) < 5 Or Len(Me.TextBox2) > 5 Then
        MsgBox "Erreur"
        Cancel = True
      End If
   End If
End Sub

Nous vérifions que 5 chiffres ont bien étés saisis.

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   masque = "#####"
   If Not Me.TextBox3 Like "#####" Then
       MsgBox "Erreur"
       Cancel = True
   End If
End Sub

Saisie de dates et heures

Saisie de dates

SaisieDates.xls

Sur cet exemple,nous vérifions si la date saisie est valide.

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  If Not IsDate(Me.TextBox1) Then
    MsgBox "Erreur saisie!"
    Cancel = True
  End If
End Sub

Private Sub TextBox1_Change()
  Calcul
End Sub

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  If Not IsNumeric(Me.TextBox2) Then
    MsgBox "Erreur saisie!"
    Cancel = True
  End If
End Sub

Private Sub TextBox2_Change()
  Calcul
End Sub

Sub Calcul()
  If IsDate(Me.TextBox1) And IsNumeric(Me.TextBox2) Then
    Me.TextBox3 = Format(CDate(Me.TextBox1) + CDbl(Me.TextBox2), "dd/mm/yy")
  End If
End Sub

Saisie d’heures

Sur cet exemple nous ajoutons les heures provenant de 2 champs.

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not EstTemps(Me.TextBox1) Then
MsgBox "Erreur saisie!"
Cancel = True
End If
End Sub

Private Sub TextBox1_Change()
Calcul
End Sub

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not EstTemps(Me.TextBox2) Then
MsgBox "Erreur saisie!"
Cancel = True
End If
End Sub

Private Sub TextBox2_Change()
Calcul
End Sub

Sub Calcul()
If IsDate(Me.TextBox1) And IsDate(Me.TextBox2) Then
Me.TextBox3 = Format(CDate(Me.TextBox1) + CDate(Me.TextBox2), "hh:mm")
End If
End Sub

Function EstTemps(t)
  p = InStr(t, ":")
  m = Mid(t, p + 1)
  EstTemps = (p > 0 And Len(m) > 0)
End Function

Total heures sup à 24

Module de classe ClasseSaisie

Public WithEvents GrSaisie As MSForms.TextBox
Private Sub GrSaisie_Change()
  t = 0
  For i = 1 To 4
    If IsDate(UserForm1("textbox" & i)) Then
       t = t + CDate(UserForm1("textbox" & i))
    End If
  Next i
  UserForm1.TextBox59 = Application.Text(t, "[h]:mm:ss")
End Sub

Formulaire:

Dim Txt(1 To 4) As New ClasseSaisie
Private Sub UserForm_Initialize()
   For b = 1 To 4: Set Txt(b).GrSaisie = Me("textbox" & b): Next b
End Sub

Saisie d'heures sous des formes différentes 10h30 ou 10/30 ou 10::30

Tout est convertit sous la forme 10:30

Private Sub TextBox1_AfterUpdate()
   Me.TextBox1 = Replace(Replace(Replace(Me.TextBox1, "h", ":"), "/", ":"), "::", ":")
End Sub

Masque de saisie date

- SaisieDates -

Dim p
Dim masque
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 8 Or KeyCode = 37 Then ' flèche gauche et backspace
    KeyCode = 0
    If p > 0 Then p = p - 1
       If p = 2 Or p = 5 Then p = p - 1
    End If
    If KeyCode = 39 Then ' flèche droite
       KeyCode = 0
       p = p + 1
       If p = 2 Or p = 5 Then p = p + 1
    End If
    If Mid(masque, p + 1, 1) = "." Then
       If KeyCode = 46 Then ' touche suppression
           Me.TextBox1 = Left(Me.TextBox1, p) & "." & Mid(Me.TextBox1, p + 2)
       End If
       If Not (KeyCode >= 48 And KeyCode <= 58 Or _
          KeyCode >= 96 And KeyCode <= 106) Then KeyCode = 0 ' Chiffres & lettes
     End If
     TextBox1.SelStart = p
     TextBox1.SelLength = 1
End Sub

Private Sub UserForm_Initialize()
   masque = "../../.."
   TextBox1 = masque
   p = 0
   TextBox1.SelStart = p
   TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_Change()
   p = p + 1
   If p = 2 Then p = 3
   If p = 5 Then p = 6
   TextBox1.SelStart = p
   TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   If Not IsDate(Me.TextBox1) Then
      Cancel = True
    End If
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    p = Me.TextBox1.SelStart
End Sub

Private Sub B_ok_Click()
    [A1] = CDate(Me.TextBox1)
End Sub

Masque de saisie Siret

Saisie No Siret

Dim p, masque
Private Sub UserForm_Initialize()
  masque = "... ... ... ....."
  TextBox1 = masque
  p = 0
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 8 Or KeyCode = 37 Then ' flèche gauche et backspace
    KeyCode = 0
    If p > 0 Then p = p - 1
    If p = 3 Or p = 7 Or p = 11 Then p = p - 1
  End If
  If KeyCode = 39 Then ' flèche droite
    KeyCode = 0
    p = p + 1
    If p = 3 Or p = 7 Or p = 11 Then p = p + 1
  End If
  If Mid(masque, p + 1, 1) = "." Then
  If KeyCode = 46 Then ' touche suppression
  Me.TextBox1 = Left(Me.TextBox1, p) & "." & Mid(Me.TextBox1, p + 2)
  End If
  If Not (KeyCode >= 48 And KeyCode <= 58 Or _
      KeyCode >= 96 And KeyCode <= 106) Then KeyCode = 0 ' Chiffres & lettes
  End If
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_Change()
  p = p + 1
  If p = 3 Then p = 4
  If p = 7 Then p = 8
  If p = 11 Then p = 12
  If p = 17 Then p = 0
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   p = Me.TextBox1.SelStart
End Sub

Private Sub B_valid_Click()
  If InStr(Me.TextBox1, ".") > 0 Then
     MsgBox "saisie incomplete"
     Me.TextBox1.SetFocus
  Else
     MsgBox Me.TextBox1
  End If
End Sub